Permalink
Browse files

initial import

Signed-off-by: Chris Granger <ibdknox@gmail.com>
  • Loading branch information...
0 parents commit 556afcdbff007fc700a4f65e69aee88f693f0751 @ibdknox committed Feb 4, 2012
Showing with 181 additions and 0 deletions.
  1. +5 −0 .gitignore
  2. +13 −0 README.md
  3. +3 −0 project.clj
  4. +91 −0 src/crate/core.cljs
  5. +21 −0 src/crate/macros.clj
  6. +41 −0 src/crate/tags.cljs
  7. +7 −0 test/crate/core_test.clj
@@ -0,0 +1,5 @@
+pom.xml
+*jar
+/lib/
+/classes/
+.lein-deps-sum
@@ -0,0 +1,13 @@
+# crate
+
+I'm an app. I sure don't do much.
+
+## Usage
+
+FIXME
+
+## License
+
+Copyright (C) 2011 FIXME
+
+Distributed under the Eclipse Public License, the same as Clojure.
@@ -0,0 +1,3 @@
+(defproject crate "0.1.0-SNAPSHOT"
+ :description "FIXME: write description"
+ :dependencies [[clojure "1.3.0"]])
@@ -0,0 +1,91 @@
+(ns crate.core
+ (:require [goog.dom :as gdom]
+ [clojure.string :as string]))
+
+(def xmlns {:xhtml "http://www.w3.org/1999/xhtml"
+ :svg "http://www.w3.org/2000/svg"})
+
+;; ********************************************
+;; Element creation via Hiccup-like vectors
+;; ********************************************
+
+(declare elem-factory)
+(def elem-id (atom 0))
+(def group-id (atom 0))
+
+(defn dom-attr
+ ([elem attrs]
+ (when elem
+ (if-not (map? attrs)
+ (. elem (getAttribute (name attrs)))
+ (do
+ (doseq [[k v] attrs]
+ (dom-attr elem k v))
+ elem))))
+ ([elem k v]
+ (. elem (setAttribute (name k) v))
+ elem))
+
+(defn as-content [parent content]
+ (doseq[c content]
+ (let [child (cond
+ (nil? c) nil
+ (map? c) (throw "Maps cannot be used as content")
+ (string? c) (gdom/createTextNode c)
+ (vector? c) (elem-factory c)
+ ;;TODO: there's a bug in clojurescript that prevents seqs from
+ ;; being considered collections
+ (seq? c) (as-content parent c)
+ (.-nodeName c) c)]
+ (when child
+ (gdom/appendChild parent child)))))
+
+;; From Weavejester's Hiccup: https://github.com/weavejester/hiccup/blob/master/src/hiccup/core.clj#L57
+(def ^{:doc "Regular expression that parses a CSS-style id and class from a tag name." :private true}
+ re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")
+
+(defn- normalize-element
+ "Ensure a tag vector is of the form [tag-name attrs content]."
+ [[tag & content]]
+ (when (not (or (keyword? tag) (symbol? tag) (string? tag)))
+ (throw (str tag " is not a valid tag name.")))
+ (let [[_ tag id class] (re-matches re-tag (name tag))
+ [nsp tag] (let [[nsp t] (string/split tag #":")
+ ns-xmlns (xmlns (keyword nsp))]
+ (if t
+ [(or ns-xmlns nsp) t]
+ [(:xhtml xmlns) nsp]))
+ tag-attrs (into {}
+ (filter #(not (nil? (second %)))
+ {:id (or id nil)
+ :class (if class (string/replace class #"\." " "))}))
+ map-attrs (first content)]
+ (if (map? map-attrs)
+ [nsp tag (merge tag-attrs map-attrs) (next content)]
+ [nsp tag tag-attrs content])))
+
+(defn parse-content [elem content]
+ (let [attrs (first content)]
+ (if (map? attrs)
+ (do
+ (dom-attr elem attrs)
+ (rest content))
+ content)))
+
+(defn create-elem [nsp tag]
+ (. js/document (createElementNS nsp tag)))
+
+(defn elem-factory [tag-def]
+ (let [[nsp tag attrs content] (normalize-element tag-def)
+ elem (create-elem nsp tag)]
+ (dom-attr elem (merge attrs {:crateId (swap! elem-id inc)}))
+ (as-content elem content)
+ elem))
+
+(defn html [& tags]
+ (let [res (map elem-factory tags)]
+ (if (second res)
+ res
+ (first res))))
+
+
@@ -0,0 +1,21 @@
+(ns crate.macros)
+
+(defmacro defpartial
+ [name params & body]
+ `(let [group# (swap! crate.core/group-id inc)]
+ (defn ^{:crateGroup group#}
+ ~name ~params
+ (.setAttribute
+ (crate.core/html
+ ~@body)
+ "crateGroup"
+ group#))
+ (set! (.-prototype._crateGroup ~name) group#)))
+
+(defmacro defelem
+ "Defines a function that will return a tag vector. If the first argument
+ passed to the resulting function is a map, it merges it with the attribute
+ map of the returned tag value."
+ [name & fdecl]
+ `(let [func# (fn ~@fdecl)]
+ (def ~name (crate.tags/add-optional-attrs func#))))
@@ -0,0 +1,41 @@
+(ns crate.tags
+ (:require-macros [crate.macros :as crate]))
+
+;; From Weavejester's Hiccup: https://github.com/weavejester/hiccup/blob/master/src/hiccup/core.clj#L284
+(defn add-optional-attrs
+ "Add an optional attribute argument to a function that returns a vector tag."
+ [func]
+ (fn [& args]
+ (if (map? (first args))
+ (let [[tag & body] (apply func (rest args))]
+ (if (map? (first body))
+ (apply vector tag (merge (first body) (first args)) (rest body))
+ (apply vector tag (first args) body)))
+ (apply func args))))
+
+(crate/defelem form-to [[method action] & content]
+ [:form {:method (name method)
+ :action action}
+ content])
+
+(crate/defelem input-field [tpe nme value]
+ [:input {:type tpe
+ :name (or nme nil)
+ :id (or nme nil)
+ :value (or value "")}])
+
+(crate/defelem text-field [nme value]
+ (input-field "text" nme value))
+
+(crate/defelem password-field [nme value]
+ (input-field "password" nme value))
+
+(crate/defelem label [for text]
+ [:label {:for for} text])
+
+(crate/defelem submit-button [val]
+ (input-field "submit" nil val))
+
+(crate/defelem link-to [url & content]
+ [:a {:href url} content])
+
@@ -0,0 +1,7 @@
+(ns crate.core-test
+ (:use clojure.test
+ crate.core))
+
+(deftest a-test
+ (testing "FIXME, I fail."
+ (is (= 0 1))))

0 comments on commit 556afcd

Please sign in to comment.