From c8c21597ab997782bbd99d6466531035fe8f4759 Mon Sep 17 00:00:00 2001
From: Thomas Hintz <t@thintz.com>
Date: Wed, 20 Apr 2016 09:21:31 -0700
Subject: [PATCH] Initial commit.

---
 README                 |   4 ++
 highlight.meta         |   8 +++
 highlight.release-info |   6 ++
 highlight.scm          | 135 +++++++++++++++++++++++++++++++++++++++++
 highlight.setup        |   7 +++
 5 files changed, 160 insertions(+)
 create mode 100644 README
 create mode 100644 highlight.meta
 create mode 100644 highlight.release-info
 create mode 100644 highlight.scm
 create mode 100644 highlight.setup

diff --git a/README b/README
new file mode 100644
index 0000000..6dc0363
--- /dev/null
+++ b/README
@@ -0,0 +1,4 @@
+Highlight
+=========
+
+Highlight is a generic syntax highlighter outputting HTML.
diff --git a/highlight.meta b/highlight.meta
new file mode 100644
index 0000000..d8940b5
--- /dev/null
+++ b/highlight.meta
@@ -0,0 +1,8 @@
+;;; highlight.meta -*- scheme -*-
+
+((egg "highlight.egg")
+ (synopsis "Syntax highlighter by file.")
+ (license "MIT")
+ (category web)
+ (depends colorize srfi-13)
+ (files "highlight.setup" "highlight.meta" "highlight.scm" "highlight.release-info"))
diff --git a/highlight.release-info b/highlight.release-info
new file mode 100644
index 0000000..4408585
--- /dev/null
+++ b/highlight.release-info
@@ -0,0 +1,6 @@
+;; -*- scheme -*-
+
+(repo git "http://code.thintz.com/highlight")
+(uri targz "http://code.thintz.com/{egg-name}/snapshot/{egg-name}-{egg-release}.tar.gz")
+
+(release "0.0.1")
diff --git a/highlight.scm b/highlight.scm
new file mode 100644
index 0000000..f0da903
--- /dev/null
+++ b/highlight.scm
@@ -0,0 +1,135 @@
+(import chicken scheme)
+(use colorize irregex srfi-13 files)
+
+(define *file* (cadr (argv)))
+
+(define *file-contents* (read-string))
+
+(define (guess-type-by-file-extension filename)
+  (and-let* ((extension (pathname-extension (make-pathname "" filename))))
+    (case (string->symbol extension)
+      ((scm) 'scheme)
+      ((lisp) 'lisp)
+      ((el) 'elisp)
+      ((c h) 'c)
+      ((cpp) 'c++)
+      ((java) 'java)
+      ((m) 'objective-c)
+      ((erl) 'erlang)
+      ((py) 'python)
+      ((rb) 'ruby)
+      ((hs) 'haskell)
+      ((diff) 'diff)
+      ((css) 'css)
+      ((xml) 'xml)
+      ((xhtml) 'xhtml)
+      ((html) 'html)
+      (else #f))))
+
+(define (guess-type-by-emacs-major-mode-variable file-contents)
+  (define (file-local-variables file-contents)
+    (and-let* ((match (irregex-search (irregex "^.*-\\*-.+-\\*-") file-contents)))
+      (irregex-search (irregex "-\\*-.+-\\*-") (irregex-match-substring match))))
+  (define (single-word-mode-line vars)
+    (irregex-match (irregex "\\s*\\w+\\s*") vars))
+  (define (mode-variable vars)
+    (irregex-search (irregex "mode:\\s*\\w+") vars))
+  (case (and-let* ((vars-match (file-local-variables file-contents))
+                   (var-string (irregex-match-substring vars-match))
+                   (vars (string-downcase
+                          (substring var-string 3 (- (string-length var-string) 3)))))
+          (cond (#f #f)
+                ((single-word-mode-line vars) =>
+                 (compose string->symbol string-trim-both irregex-match-substring))
+                ((mode-variable vars) =>
+                 (lambda (match)
+                   ;; remove mode: and trim
+                   (string->symbol
+                    (string-trim-both (substring (irregex-match-substring match) 5)))))
+                (else #f)))
+    ((scheme) 'scheme)
+    ((lisp) 'lisp)
+    ((common-lisp) 'common-lisp)
+    ((emacs-lisp) 'elisp)
+    ((c h) 'c)
+    ((c++) 'c++)
+    ((java) 'java)
+    ((erlang) 'erlang)
+    ((python) 'python)
+    ((ruby) 'ruby)
+    ((haskell) 'haskell)
+    ((diff) 'diff)
+    ((css) 'css)
+    ((xml) 'xml)
+    ((xhtml) 'xhtml)
+    ((html) 'html)
+    (else #f)))
+
+(let ((type (or (guess-type-by-file-extension *file*)
+                (guess-type-by-emacs-major-mode-variable *file-contents*))))
+  (if (not type)
+      (begin (display *file-contents*) (exit 0))
+      (begin
+        (display
+         "<style>
+.code-highlight .symbol,.code-highlight .default,.code-highlight .comment {
+    background-color: white;
+    color:#59443C;
+    font-weight:400;
+}
+
+.code-highlight i {
+    font-style:normal;
+}
+
+.code-highlight i .symbol {
+    color:#B64926;
+}
+
+.code-highlight .paren1,.code-highlight .paren2,.code-highlight .paren3,.code-highlight .paren4,.code-highlight .paren5,.code-highlight .paren6 {
+    background-color:inherit;
+}
+
+.code-highlight .paren1:hover,.code-highlight .paren2:hover,.code-highlight .paren3:hover,.code-highlight .paren4:hover,.code-highlight .paren5:hover,.code-highlight .paren6:hover {
+    color:#FFF;
+    font-weight:700;
+}
+
+.code-highlight .paren1:hover {
+    background-color:#DB7859;
+}
+
+.code-highlight .paren2:hover {
+    background-color:#1B804C;
+}
+
+.code-highlight .paren3:hover {
+    background-color:#9F214E;
+}
+
+.code-highlight .paren4:hover {
+    background-color:#DBA059;
+}
+
+.code-highlight .paren5:hover {
+    background-color:#B64926;
+}
+
+.code-highlight .paren6:hover {
+    background-color:#64A422;
+}
+
+.code-highlight .comment {
+    color:#8C8281;
+    font-style:italic;
+}
+</style>")
+
+        (display "<span class=\"code-highlight\">")
+
+        (display
+         (html-colorize type *file-contents*))
+
+        (display "</span>"))))
+
+(exit 0)
diff --git a/highlight.setup b/highlight.setup
new file mode 100644
index 0000000..36f9adc
--- /dev/null
+++ b/highlight.setup
@@ -0,0 +1,7 @@
+;;; highlight.setup -*- scheme -*-
+
+(compile -O3 -d1 highlight.scm -o highlight)
+
+(install-program 'highlight
+                 '("highlight")
+                 `((version "0.0.1")))