Re: [Orgmode] text color + highlight

[Eric Schulte]

Hi,

The attached patch implements in-buffer coloring and html export using
the syntax proposed below.

While I think this is an improvement over my previous patch, this idea
still has some shortcoming including the fact that
- nested color specifications aren't working for export (and could be
  tricky to implement)
- when using a dark-background Emacs theme colors that look good in the
  buffer generally don't look good in the html export and vise versa

The following Org-mode buffer demonstrates this patch
--8<---------------cut here---------------start------------->8---
#+Title: A Buffer with Color

* top
Some colors [color[green]are] green, and [color[red]also] red, and even html 
colors
like [color[#610B5E]these others] sometimes subtler colors.

These can also be [background[yellow]highlighted].
--8<---------------cut here---------------end--------------->8---

Cheers -- Eric

>From db9d463ce7d015de16fe768804d83132bc1780d2 Mon Sep 17 00:00:00 2001
From: Eric Schulte <address@hidden>
Date: Fri, 6 Aug 2010 11:29:33 -0400
Subject: [PATCH] introduction of colorization for html output

* lisp/org-exp.el (org-export-with-color): new customization parameter
  controlling the code colorization on export

* lisp/org-html.el (org-html-do-expand): conditional application of
  string colorization in html

  (org-export-html-colorize): apply html colorization to org-mode text

* lisp/org.el (org-fontify-colorized-text): add option to control
  in-buffer colorization of the text

  (org-do-colorize-faces): function which applies color to a buffer

  (org-set-font-lock-defaults): add coloring to the org-mode
  fontification loop
---
 lisp/org-exp.el  |    5 +++++
 lisp/org-html.el |   22 ++++++++++++++++++++++
 lisp/org.el      |   36 ++++++++++++++++++++++++++++++++++++
 3 files changed, 63 insertions(+), 0 deletions(-)

diff --git a/lisp/org-exp.el b/lisp/org-exp.el
index cd0a105..7c3d0dd 100644
--- a/lisp/org-exp.el
+++ b/lisp/org-exp.el
@@ -449,6 +449,11 @@ This option can also be set with the +OPTIONS line, e.g. 
\"*:nil\"."
   :group 'org-export-translation
   :type 'boolean)
 
+(defcustom org-export-with-color t
+  "Non-nil means apply colors to exported text."
+  :group 'org-export-translation
+  :type 'boolean)
+
 (defcustom org-export-with-footnotes t
   "If nil, export [1] as a footnote marker.
 Lines starting with [1] will be formatted as footnotes.
diff --git a/lisp/org-html.el b/lisp/org-html.el
index a12141f..1b5665b 100644
--- a/lisp/org-html.el
+++ b/lisp/org-html.el
@@ -2060,6 +2060,8 @@ If there are links in the string, don't modify these."
        (setq s (replace-match "<\\1>" t nil s))))
   (if org-export-with-emphasize
       (setq s (org-export-html-convert-emphasize s)))
+  (if org-export-with-color
+      (setq s (org-export-html-colorize s)))
   (if org-export-with-special-strings
       (setq s (org-export-html-convert-special-strings s)))
   (if org-export-with-sub-superscripts
@@ -2131,6 +2133,26 @@ If there are links in the string, don't modify these."
        (setq s (1+ s))))
     string))
 
+(defun org-export-html-colorize (string)
+  "Apply colors."
+  (let ((s1 0) (length (length string)) s2 s3 parens)
+    (while (string-match "\\[\\([^\r\n]+?\\)\\[\\(.+?\\)\\]" string s1)
+      (setq s2 s1 s3 (match-beginning 0) s1 (match-end 0) parens 1)
+      (while (and (> parens 0) (<= s1 length))
+       ((lambda (h)
+          (cond ((string= h "[") (setq parens (+ parens 1)))
+                ((string= h "]") (setq parens (- parens 1)))))
+        (substring string s1 (setq s1 (+ 1 s1)))))
+      (when (<= s1 length)
+       (setq string
+             (concat (substring string 0 s3)
+                     "<span style=\"" (match-string 1 string)
+                     ":" (match-string 2 string) ";\">"
+                     (substring string (match-end 0) (- s1 1)) "</span>"
+                     (substring string s1))))
+      (setq length (+ length 20)))
+    string))
+
 (defun org-open-par ()
   "Insert <p>, but first close previous paragraph if any."
   (org-close-par-maybe)
diff --git a/lisp/org.el b/lisp/org.el
index af4f793..772b31f 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -3294,6 +3294,12 @@ Changing this variable requires a restart of Emacs to 
take effect."
   :group 'org-appearance
   :type 'boolean)
 
+(defcustom org-fontify-colorized-text t
+  "Non-nil means colorize colored text.
+Changing this variable requires a restart of Emacs to take effect."
+  :group 'org-appearance
+  :type 'boolean)
+
 (defcustom org-fontify-whole-heading-line nil
   "Non-nil means fontify the whole line for headings.
 This is useful when setting a background color for the
@@ -4932,6 +4938,30 @@ The time stamps may be either active or inactive.")
       (backward-char 1))
     rtn))
 
+(defun org-do-colorize-faces (limit)
+  "Run through the buffer and add overlays to colored text."
+  (let ((s1 0) parens rtn)
+    (while (and (re-search-forward "\\[\\([^\r\n]+?\\)\\[\\(.+?\\)\\]" limit 
t))
+      (setq s1 (match-end 0) parens 1)
+      (while (> parens 0)
+       ((lambda (h)
+          (cond ((string= h "[") (setq parens (+ parens 1)))
+                ((string= h "]") (setq parens (- parens 1)))))
+        (buffer-substring s1 (setq s1 (+ 1 s1)))))
+      (when (<= s1 limit) (setq rtn t))
+      ;; hide wrapper
+      (add-text-properties (match-beginning 0) (+ 1 (match-end 2))
+                          '(invisible org-link))
+      (add-text-properties (- s1 1) s1 '(invisible org-link))
+      ;; color text
+      (font-lock-prepend-text-property
+       (match-end 0) s1
+       'face `((t ,(list
+                   (cond ((string= (match-string 1) "color") :foreground)
+                         (t (intern (concat ":" (match-string 1)))))
+                   (match-string 2))))))
+    rtn))
+
 (defun org-emphasize (&optional char)
   "Insert or change an emphasis, i.e. a font like bold or italic.
 If there is an active region, change that region to a new emphasis.
@@ -5385,6 +5415,7 @@ needs to be inserted at a specific position in the 
font-lock sequence.")
 
 (defun org-set-font-lock-defaults ()
   (let* ((em org-fontify-emphasized-text)
+        (co org-fontify-colorized-text)
         (lk org-activate-links)
         (org-font-lock-extra-keywords
          (list
@@ -5447,6 +5478,11 @@ needs to be inserted at a specific position in the 
font-lock sequence.")
                (if (featurep 'xemacs)
                    '(org-do-emphasis-faces (0 nil append))
                  '(org-do-emphasis-faces)))
+          ;; Color
+          (if co
+               (if (featurep 'xemacs)
+                   '(org-do-colorize-faces (0 nil append))
+                 '(org-do-colorize-faces)))
           ;; Checkboxes
           '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)"
             2 'org-checkbox prepend)
-- 
1.7.0.4

"Eric Schulte" <address@hidden> writes:

> Vinh Nguyen <address@hidden> writes:
[...]
>> What syntax to use...
>
> I've thought briefly about the following syntax
>
>  [color[red] text to be colored red]
>