Merge ce412ce into 489c1c9

README.md

@@ -24,8 +24,9 @@ See [Whidbey](https://github.com/greglook/whidbey) for nREPL and Leiningen integ
 ## Syntax Coloring
 
 Puget's first main feature is colorizing the printed data using ANSI escape
-codes. This is kind of like syntax highlighting, except much easier since the
-code works directly with the data instead of parsing it from text.
+codes or HTML `span` elements for color markup. This is kind of like syntax
+highlighting, except much easier since the code works directly with the data
+instead of parsing it from text.
 
 Different syntax elements are given different colors to make reading the
 printed output much easier for humans. The `:print-color` option can be set to
@@ -34,6 +35,15 @@ function always prints with colored output enabled:
 
 ![colorization example](screenshot.png)
 
+The `:color-markup` option defaults to `:ansi`, but can be set to `:html-inline`
+or `:html-classes` to use HTML `span` elements for color markup:
+
+  - `:html-inline` uses inline styles to apply style attributes directly to
+    each `span`'s content based on the `:color-scheme`;
+  - `:html-classes` sets the `class` of each `span` based on its syntax element
+    type (e.g., "delimiter", "keyword", "number") to allow the style for its
+    content be specified elsewhere via CSS.
+
 ## Canonical Representation
 
 Puget's other main goal is to provide _canonical serialization_ of data. In

project.clj

@@ -12,7 +12,7 @@
   :dependencies
   [[org.clojure/clojure "1.6.0"]
    [org.clojure/data.codec "0.1.0"]
-   [fipp "0.5.1"]]
+   [fipp "0.5.2"]]
 
   :cljfmt {:indents {with-options [[:block 1]]}}
 

src/puget/ansi.clj

@@ -1,7 +1,8 @@
 (ns puget.ansi
   "This namespace defines functions to apply ANSI color codes to text."
   (:require
-    [clojure.string :as str]))
+    [clojure.string :as str]
+    [puget.color :as color]))
 
 
 (def sgr-code
@@ -61,3 +62,17 @@
   "Removes color codes from the given string."
   [string]
   (str/replace string #"\u001b\[[0-9;]*[mK]" ""))
+
+
+(defmethod color/document :ansi
+  [element text options]
+  (if-let [codes (-> options :color-scheme (get element) seq)]
+    [:span [:pass (esc codes)] text [:pass (escape :none)]]
+    text))
+
+
+(defmethod color/text :ansi
+  [element text options]
+  (if-let [codes (-> options :color-scheme (get element) seq)]
+    (str (esc codes) text (escape :none))
+    text))

src/puget/color.clj

@@ -0,0 +1,36 @@
+(ns puget.color
+  "This namespace defines multimethods to add color markup to text.")
+
+;; ## Coloring Multimethods
+
+(defn dispatch
+  "Dispatches to coloring multimethods. Element should be a key from
+  the color-scheme map."
+  [element text options]
+  (and (:print-color options) (:color-markup options)))
+
+
+(defmulti document
+  "Constructs a pretty print document, which may be colored if
+  `:print-color` is true."
+  #'dispatch)
+
+
+(defmulti text
+  "Produces text colored according to the active color scheme. This is mostly
+  useful to clients which want to produce output which matches data printed by
+  Puget, but which is not directly printed by the library. Note that this
+  function still obeys the `:print-color` option."
+  #'dispatch)
+
+
+;; ## No markup when colorless
+
+(defmethod document false
+  [element text options]
+  text)
+
+
+(defmethod text false
+  [element text options]
+  text)

src/puget/html.clj

@@ -0,0 +1,103 @@
+(ns puget.html
+  "This namespace defines methods for the :html-inline
+  and :html-classes :color-markup options."
+  (:require
+    [clojure.string :as str]
+    [puget.color :as color]))
+
+(def style-attribute
+  "Map from keywords usable in a color-scheme value to vectors
+  representing css style attributes"
+  {:none       nil
+   :bold       [:font-weight "bold"]
+   :underline  [:text-decoration "underline"]
+   :blink      [:text-decoration "blink"]
+   :reverse    nil
+   :hidden     [:visibility "hidden"]
+   :strike     [:text-decoration "line-through"]
+   :black      [:color "black"]
+   :red        [:color "red"]
+   :green      [:color "green"]
+   :yellow     [:color "yellow"]
+   :blue       [:color "blue"]
+   :magenta    [:color "magenta"]
+   :cyan       [:color "cyan"]
+   :white      [:color "white"]
+   :fg-256     nil
+   :fg-reset   nil
+   :bg-black   [:background-color "black"]
+   :bg-red     [:background-color "red"]
+   :bg-green   [:background-color "green"]
+   :bg-yellow  [:background-color "yellow"]
+   :bg-blue    [:background-color "blue"]
+   :bg-magenta [:background-color "magenta"]
+   :bg-cyan    [:background-color "cyan"]
+   :bg-white   [:background-color "white"]
+   :bg-256     nil
+   :bg-reset   nil})
+
+
+(defn style
+  "Returns a formatted style attribute for a span given a seq of
+  keywords usable in a :color-scheme value"
+  [codes]
+  (let [attributes (filter identity (map style-attribute codes))]
+    (str "style=\""
+         (str/join ";" (map (fn [[k v]] (str (name k) ":" v)) attributes))
+         "\"")))
+
+
+(defn escape-html-text
+  "Escapes special characters into html entities"
+  [text]
+  (.. ^String text
+      (replace "&"  "&")
+      (replace "<"  "&lt;")
+      (replace ">"  "&gt;")
+      (replace "\"" "&quot;")))
+
+
+(defn escape-html-document
+  "Escapes special characters into fipp :span/:escaped nodes"
+  [text]
+  (let [escaped-text (escape-html-text text)
+        spans (.split escaped-text "(?=&)")]
+    (reduce (fn [acc span]
+              (case (first span)
+                nil acc
+                \& (let [[escaped span] (.split span "(?<=;)" 2)
+                         acc (conj acc [:escaped escaped])]
+                     (if (seq span)
+                       (conj acc span)
+                       acc))
+                (conj acc span)))
+            [:span]
+            spans)))
+
+
+(defmethod color/document :html-inline
+  [element text options]
+  (if-let [codes (-> options :color-scheme (get element) seq)]
+    [:span [:pass "<span " (style codes) ">"]
+     (escape-html-document text)
+     [:pass "</span>"]]
+    (escape-html-document text)))
+
+
+(defmethod color/text :html-inline
+  [element text options]
+  (if-let [codes (-> options :color-scheme (get element) seq)]
+    (str "<span " (style codes) ">" (escape-html-text text) "</span>")
+    (escape-html-text text)))
+
+
+(defmethod color/document :html-classes
+  [element text options]
+  [:span [:pass "<span class=\"" (name element) "\">"]
+   (escape-html-document text)
+   [:pass "</span>"]])
+
+
+(defmethod color/text :html-classes
+  [element text options]
+  (str "<span class=\"" (name element) "\">" (escape-html-text text) "</span>"))

src/puget/printer.clj

@@ -4,8 +4,10 @@
     [clojure.string :as str]
     [fipp.printer :as fipp]
     (puget
-      [ansi :as ansi]
+      [ansi]
+      [color :as color]
       [data :as data]
+      [html]
       [order :as order])))
 
 
@@ -39,7 +41,13 @@
   value of *print-meta*.
 
   `:print-color`
-  When true, ouptut ANSI colored text from print functions.
+  When true, ouptut colored text from print functions.
+
+  `:color-markup`
+  :ansi for ANSI color text (the default),
+  :html-inline for inline-styled html,
+  :html-classes to use the names of the keys in the :color-scheme map
+  as class names for spans so styling can be specified via CSS.
 
   `:color-scheme`
   Map of syntax element keywords to ANSI color codes."
@@ -50,6 +58,7 @@
    :map-coll-separator " "
    :print-meta nil
    :print-color false
+   :color-markup :ansi
    :color-scheme
    {; syntax elements
     :delimiter [:bold :red]
@@ -141,10 +150,7 @@
   "Constructs a text doc, which may be colored if `:print-color` is true.
   Element should be a key from the color-scheme map."
   [element text]
-  (let [codes (-> *options* :color-scheme (get element) seq)]
-    (if (and (:print-color *options*) codes)
-      [:span [:pass (ansi/esc codes)] text [:pass (ansi/escape :none)]]
-      text)))
+  (color/document element text *options*))
 
 
 (defn color-text
@@ -153,10 +159,7 @@
   Puget, but which is not directly printed by the library. Note that this
   function still obeys the `:print-color` option."
   [element text]
-  (let [codes (-> *options* :color-scheme (get element) seq)]
-    (if (and (:print-color *options*) codes)
-      (str (ansi/esc codes) text (ansi/escape :none))
-      text)))
+  (color/text element text *options*))
 
 
 

test/puget/html_test.clj

@@ -0,0 +1,106 @@
+(ns puget.html-test
+  (:require
+    [clojure.test :refer :all]
+    (puget
+     [html :as html]
+     [printer :as printer])))
+
+
+(def test-color-scheme
+  {:delimiter [:green]
+   :tag       [:bold :white]
+   :nil       [:black]
+   :boolean   [:cyan]
+   :number    [:red]
+   :string    [:magenta :underline]
+   :character [:yello]
+   :keyword   [:cyan]
+   :symbol    nil
+   :function-symbol [:bold :blue]
+   :class-delimiter [:blue]
+   :class-name      [:bold :blue]})
+
+
+(def inline-color
+  {:print-color true
+   :color-markup :html-inline})
+
+
+(def classes-color
+  {:print-color true
+   :color-markup :html-classes})
+
+
+(deftest style-test
+  (is (= "style=\"font-weight:bold;text-decoration:underline;color:red\""
+         (html/style [:bold :underline :red]))))
+
+
+(deftest html-test
+  (let [test-data {:a 1 :b 2 "c" 3.0 'd [1 2 3] \e #inst "2001"}
+        inline-ref
+        (str
+         "<span style=\"color:green\">{</span>"
+         "<span style=\"\">\\e</span> "
+         "<span style=\"font-weight:bold;color:white\">#inst</span> "
+         "<span style=\"color:magenta;text-decoration:underline\">"
+         "&quot;2001-01-01T00:00:00.000-00:00&quot;</span>, "
+         "<span style=\"color:magenta;text-decoration:underline\">&quot;c&quot;</span> "
+         "<span style=\"color:red\">3.0</span>, "
+         "<span style=\"color:cyan\">:a</span> "
+         "<span style=\"color:red\">1</span>, "
+         "<span style=\"color:cyan\">:b</span> "
+         "<span style=\"color:red\">2</span>, d "
+         "<span style=\"color:green\">[</span>"
+         "<span style=\"color:red\">1</span> "
+         "<span style=\"color:red\">2</span> "
+         "<span style=\"color:red\">3</span>"
+         "<span style=\"color:green\">]</span>"
+         "<span style=\"color:green\">}</span>")
+        classes-ref
+        (str
+         "<span class=\"delimiter\">{</span>"
+         "<span class=\"character\">\\e</span> "
+         "<span class=\"tag\">#inst</span> "
+         "<span class=\"string\">&quot;2001-01-01T00:00:00.000-00:00&quot;</span>, "
+         "<span class=\"string\">&quot;c&quot;</span> "
+         "<span class=\"number\">3.0</span>, "
+         "<span class=\"keyword\">:a</span> "
+         "<span class=\"number\">1</span>, "
+         "<span class=\"keyword\">:b</span> "
+         "<span class=\"number\">2</span>, "
+         "<span class=\"symbol\">d</span> "
+         "<span class=\"delimiter\">[</span>"
+         "<span class=\"number\">1</span> "
+         "<span class=\"number\">2</span> "
+         "<span class=\"number\">3</span>"
+         "<span class=\"delimiter\">]</span>"
+         "<span class=\"delimiter\">}</span>")]
+    (is (= inline-ref
+           (printer/cprint-str test-data {:color-markup :html-inline
+                                          :color-scheme test-color-scheme})))
+    (is (= classes-ref
+           (printer/cprint-str test-data {:color-markup :html-classes}))))
+  (testing "color-text"
+    (testing "no color markup"
+      (is (= ":inline>"
+             (printer/color-text :keyword ":inline>")))
+      (is (= ":classes<"
+             (printer/color-text :keyword ":classes<"))))
+    (testing "unrecognized element html color markup"
+      (is (= "in&lt;line"
+             (printer/with-options inline-color
+               (printer/color-text :bogus "in<line"))))
+      (is (= "<span class=\"bogus\">&quot;classes</span>"
+             (printer/with-options classes-color
+               (printer/color-text :bogus "\"classes")))))
+    (testing "happy path html color markup"
+      (is (= (str "<span style=\"font-weight:bold;color:yellow\">"
+                  ":in&amp;line</span>")
+             (printer/with-options inline-color
+               (printer/color-text :keyword ":in&line"))))
+      (is (= "<span class=\"keyword\">:classes&lt;&gt;</span>"
+             (printer/with-options classes-color
+               (printer/color-text :keyword ":classes<>")))))
+    (testing "escaping empty content"
+      (is (= [:span] (html/escape-html-document ""))))))