From 74362743504f7ad6c81cb2a7e4d2882b6dc3f5ad Mon Sep 17 00:00:00 2001
From: Carsten Dominik <carsten.dominik@gmail.com>
Date: Sat, 3 May 2008 16:17:43 +0200
Subject: [PATCH] Implement color formatting of code examples during HTML
 export.

---
 ORGWEBPAGE/Changes.org | 37 +++++++++++++++++--
 lisp/org-exp.el        | 81 ++++++++++++++++++++++++++++++++++++++++++
 lisp/org.el            | 18 ++++++++--
 3 files changed, 131 insertions(+), 5 deletions(-)

diff --git a/ORGWEBPAGE/Changes.org b/ORGWEBPAGE/Changes.org
index 59b5ee282..7c5d2c65c 100644
--- a/ORGWEBPAGE/Changes.org
+++ b/ORGWEBPAGE/Changes.org
@@ -8,13 +8,16 @@
 #+LINK_UP: index.html
 #+LINK_HOME: http://orgmode.org
 
-* Version 6.02a
+* Version 6.03
+
 ** Details
-*** Clock task history
+
+*** Clock task history, and moving entries with the running clock
+
     Org now remembers the last 5 tasks that you clocked into, to
     make it easier to clock back into a task after interrupting
     it for another task.
-    - `C-u C-u C-c C-x C-i' (or `C-u C-u I' from the agenda) wil
+    - `C-u C-u C-c C-x C-i' (or `C-u C-u I' from the agenda) will
       clock into that task and mark it as current default task.
     - `C-u C-c C-x C-i' (or `C-u I' from the agenda) will offer a
       list of recently clocked tasks, including the default task,
@@ -23,6 +26,34 @@
       being clocked. `1',... selects a recent task.  When you
       select a task, you will be clocked into it.
 
+    When moving an entry using structure editing commands,
+    archiving commands, or the special subtree cut-and-paste
+    commands =C-c C-x C-w= and =C-c C-x C-y=, the running clock
+    marker and all clock history markers will be moved with the
+    subtree.  Now you can start a clock in a remember buffer and
+    keep the clock running while filing the note away.  See also
+    the variable `org-remember-clock-out-on-exit'.
+
+*** Fontified code examples in HTML export
+
+    You can now get code examples fontified like they would be
+    fontified in an emacs buffer, and export the result to HTML.
+    To do so, wrap the code examples into the following
+    structure:
+
+    : #+BEGIN_SRC emacs-lisp
+    : (defun org-xor (a b)
+    :   "Exclusive or."
+    :   (if a (not b) b))
+    : #+END_SRC
+
+    The string after the BEGIN_SRC is the name of the major emacs
+    mode that should be used to fontify the code example.
+
+    Currently this works only for HTML export, and requires the
+    /htmlize.el/ package.  For other backends, such structures are
+    exported as EXAMPLE.
+
 * Version 6.02
 
 ** Overview
diff --git a/lisp/org-exp.el b/lisp/org-exp.el
index d4d0f89ad..1945a663a 100644
--- a/lisp/org-exp.el
+++ b/lisp/org-exp.el
@@ -1198,6 +1198,9 @@ on this string to produce the exported version."
       (let ((org-inhibit-startup t)) (org-mode))
       (untabify (point-min) (point-max))
 
+      ;; Handle source code snippets
+      (org-export-replace-src-segments)
+
       ;; Get rid of drawers
       (unless (eq t exp-drawers)
 	(goto-char (point-min))
@@ -1317,6 +1320,13 @@ on this string to produce the exported version."
 			     '(org-protected t))
 	(goto-char (1+ (match-end 4))))
 
+      ;; Blockquotes
+      (goto-char (point-min))
+      (while (re-search-forward "^#\\+\\(begin\\|end\\)_\\(block\\)quote\\>.*" nil t)
+	(replace-match (if (equal (downcase (match-string 1)) "end")
+			   "ORG-BLOCKUQUOTE-END" "ORG-BLOCKUQUOTE-START")
+			 t t))
+
       ;; Remove subtrees that are commented
       (goto-char (point-min))
       (while (re-search-forward re-commented nil t)
@@ -1557,6 +1567,68 @@ When LEVEL is non-nil, increase section numbers on that level."
 	  (setq string (replace-match "" t nil string))))
     string))
 
+;;; Fontification of code
+;; Currently only for th HTML backend, but who knows....
+(defun org-export-replace-src-segments ()
+  "Replace source code segments with special code for export."
+  (let (lang code trans)
+    (goto-char (point-min))
+    (while (re-search-forward
+	    "^#\\+BEGIN_SRC[ \t]+\\([^ \t\n]+\\)[ \t]*\n\\([^\000]+?\n\\)#\\+END_SRC.*"
+	    nil t)
+      (setq lang (match-string 1) code (match-string 2)
+	    trans (org-export-format-source-code lang code))
+      (replace-match trans t t))))
+
+(defvar htmlp)  ;; dynamically scoped from org-exp.el
+
+(defun org-export-format-source-code (lang code)
+  "Format CODE from language LANG and return it formatted for export.
+Currently, this only does something for HTML export, for all other
+backends, it converts the segment into an EXAMPLE segment."
+  (cond
+   (htmlp
+    ;; We are exporting to HTML
+    (condition-case nil (require 'htmlize) (nil t))
+    (if (not (fboundp 'htmlize-region-for-paste))
+	(progn
+	  ;; we do not have htmlize.el, or an old version of it
+	  (message
+	   "htmlize.el 1.34 or later is needed for source code formatting")
+	  (concat "#+BEGIN_EXAMPLE\n" code
+		  (if (string-match "\n\\'" code) "" "\n")
+		  "#+END_EXAMPLE\n"))
+      ;; ok, we are good to go
+      (save-match-data
+	(let* ((mode (and lang (intern (concat lang "-mode"))))
+	       (org-startup-folded nil)
+	       (htmltext
+		(with-temp-buffer
+		  (insert code)
+		  (if (functionp mode)
+		      (funcall mode)
+		    (fundamental-mode))
+		  (when (eq major-mode 'org-mode)
+		    ;; Free up the protected stuff
+		    (goto-char (point-min))
+		    (while (re-search-forward "^@\\([*#]\\|[ \t]*:\\)" nil t)
+		      (replace-match "\\1"))
+		    (org-mode))
+		  (font-lock-fontify-buffer)
+		  ;; silence the byte-compiler
+		  (when (fboundp 'htmlize-region-for-paste)
+		    ;; transform the region to HTML
+		    (htmlize-region-for-paste (point-min) (point-max))))))
+	  (if (string-match "<pre\\([^>]*\\)>\n?" htmltext)
+	      (setq htmltext (replace-match "<pre class=\"src\">"
+					    t t htmltext)))
+	  (concat "#+BEGIN_HTML\n" htmltext "\n#+END_HTML\n")))))
+   (t
+    ;; This is not HTML, so just make it an example.
+    (concat "#+BEGIN_EXAMPLE\n" code
+	    (if (string-match "\n\\'" code) "" "\n")
+	    "#+END_EXAMPLE\n"))))
+
 ;;; ASCII export
 
 (defvar org-last-level nil) ; dynamically scoped variable
@@ -2466,6 +2538,7 @@ lang=\"%s\" xml:lang=\"%s\">
 		(replace-match "\\2\n"))
 	      (insert line "\n")
 	      (while (and lines
+			  (not (string-match "^[ \t]*:" (car lines)))
 			  (or (= (length (car lines)) 0)
 			      (get-text-property 0 'org-protected (car lines))))
 		(insert (pop lines) "\n"))
@@ -2477,6 +2550,14 @@ lang=\"%s\" xml:lang=\"%s\">
 	    (insert "\n<hr/>\n")
 	    (throw 'nextline nil))
 
+	  ;; Blockquotes
+	  (when (equal "ORG-BLOCKUQUOTE-START" line)
+	    (insert "<blockquote>\n<p>\n")
+	    (throw 'nextline nil))
+	  (when (equal "ORG-BLOCKUQUOTE-END" line)
+	    (insert "</p>\n</blockquote>\n")
+	    (throw 'nextline nil))
+
 	  ;; make targets to anchors
 	  (while (string-match "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line)
 	    (cond
diff --git a/lisp/org.el b/lisp/org.el
index acb9db0ec..a34d7e91c 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4036,8 +4036,6 @@ are at least `org-cycle-separator-lines' empty lines before the headeline."
 	    (outline-flag-region b (point-at-eol) flag)
 	  (error ":END: line missing"))))))
 
-
-
 (defun org-subtree-end-visible-p ()
   "Is the end of the current subtree visible?"
   (pos-visible-in-window-p
@@ -12732,6 +12730,22 @@ With optional NODE, go directly to that node."
 
 ;;; Generally useful functions
 
+(defun org-display-warning (message) ;; Copied from Emacs-Muse
+  "Display the given MESSAGE as a warning."
+  (if (fboundp 'display-warning)
+      (display-warning 'org message
+                       (if (featurep 'xemacs)
+                           'warning
+                         :warning))
+    (let ((buf (get-buffer-create "*Org warnings*")))
+      (with-current-buffer buf
+        (goto-char (point-max))
+        (insert "Warning (Org): " message)
+        (unless (bolp)
+          (newline)))
+      (display-buffer buf)
+      (sit-for 0))))
+
 (defun org-plist-delete (plist property)
   "Delete PROPERTY from PLIST.
 This is in contrast to merely setting it to 0."