Move syntax highlighting to ClojureScript, to reduce code size a bit

demo/reagentdemo/intro.cljs

@@ -3,7 +3,7 @@
             [reagent.interop :refer-macros [.' .!]]
             [reagent.debug :refer-macros [dbg println]]
             [clojure.string :as string]
-            [reagentdemo.syntax :as s :include-macros true]
+            [reagentdemo.syntax :as s]
             [sitetools :refer [link]]
             [reagentdemo.common :as common :refer [demo-component]]
             [simpleexample :as simple]

demo/reagentdemo/news/anyargs.cljs

@@ -2,7 +2,7 @@
   (:require [reagent.core :as r :refer [atom]]
             [reagent.interop :refer-macros [.' .!]]
             [reagent.debug :refer-macros [dbg println]]
-            [reagentdemo.syntax :as s :include-macros true]
+            [reagentdemo.syntax :as s]
             [sitetools :as tools :refer [link]]
             [reagentdemo.common :as common :refer [demo-component]]
             [geometry.core :as geometry]))

demo/reagentdemo/news/async.cljs

@@ -2,7 +2,7 @@
   (:require [reagent.core :as reagent :refer [atom]]
             [reagent.interop :refer-macros [.' .!]]
             [reagent.debug :refer-macros [dbg println]]
-            [reagentdemo.syntax :as s :include-macros true]
+            [reagentdemo.syntax :as s]
             [sitetools :as tools :refer [link]]
             [reagentdemo.common :as common :refer [demo-component]]))
 

demo/reagentdemo/news/clockpost.cljs

@@ -2,7 +2,7 @@
   (:require [reagent.core :as r :refer [atom]]
             [reagent.interop :refer-macros [.' .!]]
             [reagent.debug :refer-macros [dbg]]
-            [reagentdemo.syntax :as s :include-macros true]
+            [reagentdemo.syntax :as s]
             [sitetools :as tools :refer [link]]
             [reagentdemo.common :as common :refer [demo-component]]
             [reagentdemo.news.binaryclock :as binaryclock]))

demo/reagentdemo/news/news050.cljs

@@ -2,7 +2,7 @@
   (:require [reagent.core :as r :refer [atom]]
             [reagent.interop :refer-macros [.' .!]]
             [reagent.debug :refer-macros [dbg println]]
-            [reagentdemo.syntax :as s :include-macros true]
+            [reagentdemo.syntax :as s]
             [sitetools :as tools :refer [link]]
             [reagentdemo.common :as common :refer [demo-component]]
             [todomvc :as todomvc]))

demo/reagentdemo/news/undodemo.cljs

@@ -2,7 +2,7 @@
   (:require [reagent.core :as reagent :refer [atom]]
             [reagent.interop :refer-macros [.' .!]]
             [reagent.debug :refer-macros [dbg println]]
-            [reagentdemo.syntax :as s :include-macros true]
+            [reagentdemo.syntax :as s]
             [sitetools :as tools :refer [link]]
             [reagentdemo.common :as common :refer [demo-component]]
             [todomvc :as todomvc]))

demo/reagentdemo/syntax.clj

@@ -3,95 +3,6 @@
             [clojure.string :as string]))
 
 
-;;;;; Colorization
-
-(def builtins #{"def" "defn" "ns" "atom" "let" "if" "when"
-               "cond" "merge" "assoc" "swap!" "reset!" "for"
-               "range" "nil?" "int" "or" "->" "->>" "%" "fn" "if-not"
-               "empty?" "case" "str" "pos?" "zero?" "map" "remove"
-               "empty" "into" "assoc-in" "dissoc" "get-in" "when-not"
-               "filter" "vals" "count" "complement" "identity" "dotimes"
-               "update-in" "sorted-map" "inc" "dec" "false" "true" "not"
-               "=" "partial" "first" "second" "rest" "list" "conj"
-               "drop" "when-let" "if-let" "add-watch" "mod" "quot"
-               "bit-test" "vector"})
-
-(def me "reagentdemo.syntax")
-
-(def styles {:comment  (symbol me "comment-span")
-             :str-litt (symbol me "string-span")
-             :keyw     (symbol me "keyword-span")
-             :builtin  (symbol me "builtin-span")
-             :def      (symbol me "def-span")})
-
-(def paren-styles [(symbol me "paren-span-1")
-                   (symbol me "paren-span-2")
-                   (symbol me "paren-span-3")])
-
-(defn tokenize [src]
-  (let [ws " \\t\\n"
-        open "\\[({"
-        close ")\\]}"
-        sep (str ws open close)
-        comment-p ";.*"
-        str-p "\"[^\"]*\""
-        open-p (str "[" open "]")
-        close-p (str "[" close "]")
-        iden-p (str "[^" sep "]+")
-        meta-p (str "\\^" iden-p)
-        any-p (str "[" ws "]+" "|\\^[^" sep "]+|.")
-        patt (re-pattern (str "("
-                              (string/join ")|(" [comment-p str-p open-p
-                                                  close-p meta-p iden-p any-p])
-                              ")"))
-        keyw-re #"^:"]
-    (for [[s comment str-litt open close met iden any] (re-seq patt src)]
-      (cond
-       comment [:comment s]
-       str-litt [:str-litt s]
-       open [:open s]
-       close [:close s]
-       met [:other s]
-       iden (cond
-             (re-find keyw-re s) [:keyw s]
-             (builtins s) [:builtin s]
-             :else [:iden s])
-       any [:other s]))))
-
-(defn syntaxify [src]
-  (let [def-re #"^def|^ns\b"
-        ncol (count paren-styles)
-        paren-style (fn [level]
-                      (nth paren-styles (mod level ncol)))]
-    (loop [tokens (tokenize (str src " "))
-           prev nil
-           level 0
-           res []]
-      (let [[kind val] (first tokens)
-            level' (case kind
-                     :open (inc level)
-                     :close (dec level)
-                     level)
-            style (case kind
-                    :iden  (when (and prev (re-find def-re prev))
-                             (:def styles))
-                    :open  (paren-style level)
-                    :close (paren-style level')
-                    (styles kind))
-            remain (rest tokens)]
-        (if-not (empty? remain)
-          (recur remain
-                 (if (= kind :other) prev val)
-                 level'
-                 (if (nil? style)
-                   (let [old (peek res)]
-                     (if (string? old)
-                       (conj (pop res) (str old val))
-                       (conj res val)))
-                   (conj res (list style val))))
-          (apply vector :pre res))))))
-
-
 ;;;; Source splitting
 
 (defn src-parts [src]
@@ -108,11 +19,12 @@
 (defn src-for-names [srcmap names]
   (string/join "\n" (map srcmap names)))
 
+
 ;;; Macros
 
 (defmacro syntaxed [src]
   (assert (string? src))
-  (syntaxify src))
+  `(reagentdemo.syntax/syntaxify ~src))
 
 (defmacro src-of
   ([funs]
@@ -132,4 +44,4 @@
          sel (if (nil? funs)
                src
                (-> src fun-map (src-for-names funs)))]
-     (syntaxify sel))))
+     `(reagentdemo.syntax/syntaxify ~sel))))

demo/reagentdemo/syntax.cljs

@@ -1,4 +1,5 @@
 (ns reagentdemo.syntax
+  (:require-macros reagentdemo.syntax)
   (:require [clojure.string :as string]))
 
 ;; Styles for syntax highlighting
@@ -17,14 +18,86 @@
 (def paren-style-3 {:style {:color "#44a"}})
 
 
-;; Function shortcuts to reduce code size a bit
+;;;;; Colorization
 
-(defn comment-span [v] [:span comment-style v])
+(def builtins #{"def" "defn" "defonce" "ns" "atom" "let" "if" "when"
-(defn string-span [v] [:span string-style v])
+               "cond" "merge" "assoc" "swap!" "reset!" "for"
-(defn keyword-span [v] [:span keyword-style v])
+               "range" "nil?" "int" "or" "->" "->>" "%" "fn" "if-not"
-(defn builtin-span [v] [:span builtin-style v])
+               "empty?" "case" "str" "pos?" "zero?" "map" "remove"
-(defn def-span [v] [:span def-style v])
+               "empty" "into" "assoc-in" "dissoc" "get-in" "when-not"
+               "filter" "vals" "count" "complement" "identity" "dotimes"
+               "update-in" "sorted-map" "inc" "dec" "false" "true" "not"
+               "=" "partial" "first" "second" "rest" "list" "conj"
+               "drop" "when-let" "if-let" "add-watch" "mod" "quot"
+               "bit-test" "vector"})
 
-(defn paren-span-1 [v] [:span paren-style-1 v])
+(def styles {:comment  comment-style
-(defn paren-span-2 [v] [:span paren-style-2 v])
+             :str-litt string-style
-(defn paren-span-3 [v] [:span paren-style-3 v])
+             :keyw     keyword-style
+             :builtin  builtin-style
+             :def      def-style})
+
+(def paren-styles [paren-style-1 paren-style-2 paren-style-3])
+
+(defn tokenize [src]
+  (let [ws " \\t\\n"
+        open "\\[({"
+        close ")\\]}"
+        sep (str ws open close)
+        comment-p ";.*"
+        str-p "\"[^\"]*\""
+        open-p (str "[" open "]")
+        close-p (str "[" close "]")
+        iden-p (str "[^" sep "]+")
+        meta-p (str "\\^" iden-p)
+        any-p (str "[" ws "]+" "|\\^[^" sep "]+|.")
+        patt (re-pattern (str "("
+                              (string/join ")|(" [comment-p str-p open-p
+                                                  close-p meta-p iden-p any-p])
+                              ")"))
+        keyw-re #"^:"]
+    (for [[s comment str-litt open close met iden any] (re-seq patt src)]
+      (cond
+       comment [:comment s]
+       str-litt [:str-litt s]
+       open [:open s]
+       close [:close s]
+       met [:other s]
+       iden (cond
+             (re-find keyw-re s) [:keyw s]
+             (builtins s) [:builtin s]
+             :else [:iden s])
+       any [:other s]))))
+
+(defn syntaxify [src]
+  (let [def-re #"^def|^ns\b"
+        ncol (count paren-styles)
+        paren-style (fn [level]
+                      (nth paren-styles (mod level ncol)))]
+    (loop [tokens (tokenize (str src " "))
+           prev nil
+           level 0
+           res []]
+      (let [[kind val] (first tokens)
+            level' (case kind
+                     :open (inc level)
+                     :close (dec level)
+                     level)
+            style (case kind
+                    :iden  (when (and prev (re-find def-re prev))
+                             (:def styles))
+                    :open  (paren-style level)
+                    :close (paren-style level')
+                    (styles kind))
+            remain (rest tokens)]
+        (if-not (empty? remain)
+          (recur remain
+                 (if (= kind :other) prev val)
+                 level'
+                 (if (nil? style)
+                   (let [old (peek res)]
+                     (if (string? old)
+                       (conj (pop res) (str old val))
+                       (conj res val)))
+                   (conj res [:span style val])))
+          (apply vector :pre res))))))