ClojureScript One Guide

VIEW ON GITHUB »

one

1.0.0-SNAPSHOT


Getting Started with ClojureScript.

dependencies

org.clojure/clojure
1.3.0
ring
1.0.0-RC1
compojure
0.6.4
enlive
1.0.0
org.mozilla/rhino
1.7R3
com.google.javascript/closure-compiler
r1592
org.clojure/google-closure-library
0.0-790

dev dependencies

jline
0.9.94
marginalia
0.7.0-SNAPSHOT
lein-marginalia
0.7.0-SNAPSHOT



(this space intentionally left almost blank)
 

one.application

toc

This namespace contains the configuration for a ClojureScript One application. Every 'One' application must have a one.application namespace with a valid configuration.

(ns one.application
  (:use [one.sample.api :only (remote-routes)])
  (:require [net.cgrand.enlive-html :as html]))
(defn- production-transform [h]
  (html/transform h
                  [:ul#navigation]
                  (html/substitute (html/html-snippet ))))

Configuration for the sample application.

(def 
  config {:src-root "src"
          :app-root "src/app/cljs"
          :top-level-package "one"
          :js "public/javascripts"
          :dev-js-file-name "main.js"
          :prod-js-file-name "mainp.js"
          :dev-js ["goog.require('one.sample.core');"
                   "goog.require('one.sample.model');"
                   "goog.require('one.sample.controller');"
                   "goog.require('one.sample.history');"
                   "goog.require('one.sample.logging');"
                   "one.sample.core.start();one.sample.core.repl();"]
          :prod-js ["one.sample.core.start();"]
          :reload-clj ["/one/host_page"
                       "/one/reload"
                       "/one/templates"
                       "/one/sample/api"
                       "/one/application"
                       "/one/dev_server"]
          :prod-transform production-transform
          :api-routes remote-routes})
 

one.sample.api

toc

The server side of the sample application. Provides a simple API for updating an in-memory database.

(ns one.sample.api
  (:use [compojure.core :only (defroutes POST)]))
(defonce ^:private next-id (atom 0))
(defonce ^:dynamic *database* (atom #{}))

Multimethod to handle incoming API calls. Implementations are selected based on the :fn key in the data sent by the client. Implementation are called with whatever data struture the client sends (which will already have been read into a Clojure value) and can return any Clojure value. The value the implementation returns will be serialized to a string before being sent back to the client.

(defmulti remote
  :fn)
(defmethod remote :default [data]
  {:status :error :message "Unknown endpoint."})
(defmethod remote :add-name [data]
  (let [n (-> data :args :name)
        response {:exists (contains? @*database* n)}]
    (swap! *database* conj n)
    response))
(defroutes remote-routes
  (POST "/remote" {{data "data"} :params}
        (pr-str
         (remote
          (binding [*read-eval* false]
            (read-string data))))))
 

one.sample.prod-server

toc

Production server serves the backend API. This is only required if there is a backend API.

(ns one.sample.prod-server
  (:use [ring.adapter.jetty :only (run-jetty)]
        [ring.middleware.file :only (wrap-file)]
        [ring.middleware.file-info :only (wrap-file-info)]
        [ring.middleware.params :only (wrap-params)]
        [ring.util.response :only (file-response)]
        [compojure.core :only (defroutes ANY)]
        [one.sample.api :only (remote-routes)]))
(def ^:private root "out/public")

HACK: Something about the defroutes below requires that the out/public directory exist, or we get a compile error.

(.mkdirs (java.io.File. "out/public"))
(defroutes app-routes
  remote-routes
  (-> (ANY "*" request (file-response "404.html" {:root root}))
      (wrap-file root)
      wrap-file-info))
(def ^:private app (-> app-routes
                       wrap-params))
(defn run-server []
  (let [port (Integer/parseInt (get (System/getenv) "PORT" "8080"))]
    (run-jetty (var app) {:join? false :port port})))
 

one.sample.repl

toc

The starting namespace for the project. This is the namespace that users will land in when they start a Clojure REPL. It exists to provide convenience functions like 'go' and 'dev-server'.

(ns one.sample.repl
  (:use [clojure.repl])
  (:require [one.tools :as tools]
            [one.dev-server :as dev]
            [clojure.java.browse :as browse]))

Start a browser-connected REPL and launch a browser to talk to it.

(defn go
  []
  (dev/run-server)
  (future (Thread/sleep 3000)
          (browse/browse-url "http://localhost:8080/development"))
  (tools/cljs-repl))

Start the development server and open the host application in the default browser.

(defn dev-server
  []
  (dev/run-server)
  (future (Thread/sleep 3000)
          (browse/browse-url "http://localhost:8080")))

Start a ClojureScript REPL.

This is a convenience function so that people can start a CLJS REPL without having to type in (tools/cljs-repl)

(defn cljs-repl
  []
  (tools/cljs-repl))
(println)
(println "Type (go) to launch the development server and setup a browser-connected REPL.")
(println "Type (dev-server) to launch only the development server.")
(println)
 

script.build

toc

Contains a -main function which builds the production artifacts for the project.

(ns script.build
  (:require [clojure.java.io :as io]
            [one.tools :as tools]
            [one.application :as config]))

Compile ClojureScript sources and output them as well as all static resources to the out/public directory.

(defn -main
  []
  (println "Creating out/public...")
  (.mkdir (io/file "out"))
  (tools/copy-recursive-into "public" "out")
  (tools/delete "out/public/index.html"
                "out/public/design.html"
                "out/public/javascripts")
  (.mkdir (io/file "out/public/javascripts"))
  (println "Create advanced compiled JavaScript...")
  (tools/build-project config/config))
 

script.serve

toc

Provides a -main function which will start the production server.

(ns script.serve
  (:require [one.sample.prod-server :as prod]))

Start the production server which serves the content from out/public as well as the sample application's API.

(defn -main
  []
  (prod/run-server))
 

one.sample.snippets

toc

Macros for including HTML snippets in the ClojureScript application at compile time.

(ns one.sample.snippets
  (:use [one.templates :only (render construct-html)])
  (:require [net.cgrand.enlive-html :as html]))
(defn- snippet [file id]
  (render (html/select (construct-html (html/html-resource file)) id)))

Expands to a map of HTML snippets which are extracted from the design templates.

(defmacro snippets
  []
  {:form (snippet "form.html" [:div#form])
   :greeting (snippet "greeting.html" [:div#greeting])})
 

leiningen.bootstrap

toc

Bootstrap the project by running lein deps and lein git-deps.

(ns leiningen.bootstrap
  (:use [leiningen.git-deps :only [git-deps]]
        [leiningen.core :only [default-repos]]
        [leiningen.deps :only [deps]]
        [leiningen.util.maven :only [container make-remote-artifact
                                     make-remote-repo make-local-repo]])
  (:import (org.apache.maven.artifact.resolver ArtifactResolver)))

There is a bug in Leiningen 1.6.2 which requires that you have Clojure 1.2.1 in the local maven repository when you are working on a Clojure 1.3 project. If the first project that someone works on with Leiningen is a Clojure 1.3 based project then they will encounter this problem.

A lot of people have run into this with ClojureScript One so we have added a workaround.

Leiningen includes an install task which, for some unknown reason, takes a long time to run. Below, we have extracted just the part of that task that we need to get a dependency from a maven repository.

Download a dependency from a maven repository.

(defn- standalone-download
  [name group version]
  (.resolveAlways (.lookup container ArtifactResolver/ROLE)
                  (make-remote-artifact name group version)
                  (map make-remote-repo default-repos)
                  (make-local-repo)))

Bootstrap the project by running lein deps and lein git-deps.

(defn bootstrap
  [project]
  ;; Workarond for Leiningen 1.6.2 bug. Ensure that we have Clojure 1.2.1 in
  ;; the local maven repository.
  (standalone-download "clojure" "org.clojure" "1.2.1")
  (git-deps project)
  (deps project))
 

leiningen.git-deps

toc

How this works: It clones projects into .lein-git-deps/. If the directory already exists, it does a git pull and git checkout.

(ns leiningen.git-deps
  (:require [clojure.java.shell :as sh]
            [clojure.java.io :as io]
            [clojure.string :as string]))

The directory into which dependencies will be cloned.

(def ^{:private true
       :doc }
  git-deps-dir ".lein-git-deps")

Return true if the specified directory exists.

(defn- directory-exists?
  [dir]
  (.isDirectory (io/file dir)))

Given a git URL, return the directory it would clone into by default.

(defn- default-clone-dir
  [uri]
  (string/join "." (-> uri
                       (string/split #"/")
                       (last)
                       (string/split #"\.")
                       butlast)))

Run a command, throwing an exception if it fails, returning the result as with clojure.java.shell/sh.

(defn- exec
  [& args]
  (let [{:keys [exit out err] :as result} (apply sh/sh args)]
    (if (zero? exit)
      result
      (throw
       (Exception.
        (format "Command %s failed with exit code %s\n%s\n%s"
                (apply str (interpose " " args))
                exit
                out
                err))))))

Clone the git repository at url into dir-name while working in directory working-dir.

(defn- git-clone
  [url dir-name working-dir]
  (apply exec (remove nil? ["git" "clone" url (str dir-name) :dir working-dir])))

Check out the specified commit in dir.

(defn- git-checkout
  [commit dir]
  (println "Running git checkout " commit " in " (str dir))
  (exec "git" "checkout" commit :dir dir))

Return true if the git repository in dir has HEAD detached.

(defn- detached-head?
  [dir]
  (let [{out :out} (exec "git" "branch" "--no-color" :dir dir)
        lines (string/split-lines out)
        current-branch (first (filter #(.startsWith % "*") lines))]
    (when-not current-branch
      (throw (Exception. "Unable to determine current branch")))
    (= current-branch "* (no branch)")))

Run 'git-pull' in directory dir, but only if we're on a branch. If HEAD is detached, we only do a fetch, not a full pull.

(defn- git-pull
  [dir]
  (println "Running git pull on " (str dir))
  (if (detached-head? dir)
    (do
      (println "Not on a branch, so fetching instead of pulling.")
      (exec "git" "fetch" :dir dir))
    (exec "git" "pull" :dir dir)))

A leiningen task that will pull dependencies in via git.

Dependencies should be listed in project.clj under the :git-dependencies key in one of these three forms:

:git-dependencies [;; First form: just a URL.
                   ["https://github.com/foo/bar.git"]

                   ;; Second form: A URL and a ref, which can be anything
                   ;; you can specify for 'git checkout', like a commit id
                   ;; or a branch name.
                   ["https://github.com/foo/baz.git"
                    "329708b"]

                   ;; Third form: A URL, a commit, and a map
                   ["https://github.com/foo/quux.git"
                    "some-branch"
                    {:dir "alternate-directory"}]]
(defn git-deps
  [project]
  (when-not (directory-exists? git-deps-dir)
    (.mkdir (io/file git-deps-dir)))
  (doseq [dep (:git-dependencies project)]
    (println "Setting up dependency for " dep)
    (let [[dep-url commit {clone-dir-name :dir}] dep
          commit (or commit "master")
          clone-dir-name (or clone-dir-name (default-clone-dir dep-url))
          clone-dir (io/file git-deps-dir clone-dir-name)]
      (if (directory-exists? clone-dir)
        (git-pull clone-dir)
        (git-clone dep-url clone-dir-name git-deps-dir))
      (git-checkout commit clone-dir))))
 

one.config

toc

Convenience functions for working with configuration data.

(ns 
  one.config)

Given a configuration map, return output directory options.

(defn cljs-build-opts
  [config]
  {:output-to (str (:js config) "/" (:dev-js-file-name config))
   :output-dir (str (:js config) "/out")
   :libs (:libs config)
   :externs (:externs config)
   :foreign-libs (:foreign-libs config)})

Given a configuration map, return the path to the production Javascript file.

(defn production-js
  [config]
  (str (:js config) "/" (:prod-js-file-name config)))
 

one.dev-server

toc

Serve a friendly ClojureScript environment with code reloading and the ClojureScript application in both development and advanced compiled mode.

(ns one.dev-server
  (:use [ring.adapter.jetty :only (run-jetty)]
        [ring.middleware.file :only (wrap-file)]
        [ring.middleware.file-info :only (wrap-file-info)]
        [ring.middleware.params :only (wrap-params)]
        [ring.middleware.stacktrace :only (wrap-stacktrace)]
        [ring.util.response :only (file-response)]
        [compojure.core :only (defroutes GET POST ANY)]
        [cljs.repl :only (repl)]
        [cljs.repl.browser :only (repl-env)]
        [one.templates :only (load-html apply-templates render)]
        [one.host-page :only (application-host)]
        [one.application])
  (:require [net.cgrand.enlive-html :as html]
            [one.reload :as reload])
  (:import java.io.File))
(defn- environment [uri]
  (case uri
    "/development" :development
    "/production" :production
    "/fresh" :fresh))
(defn- make-host-page [request]
  {:status 200
   :headers {"Content-Type" "text/html; charset=utf-8"}
   :body (application-host config (environment (:uri request)))})
(defroutes app-routes
  (:api-routes config)
  (GET "/development" request (make-host-page request))
  (GET "/production" request (make-host-page request))
  (GET "/fresh" request (make-host-page request))
  (GET "/design*" {{file :*} :route-params}
       (when (.endsWith file ".html")
         (load-html (.substring file 1))))
  (ANY "*" request (file-response "404.html" {:root "public"})))
(defn- js-encoding [handler]
  (fn [request]
    (let [{:keys [headers body] :as response} (handler request)]
      (if (and (= (get headers "Content-Type") "text/javascript")
               (= (type body) File))
        (assoc-in response [:headers "Content-Type"]
                  "text/javascript; charset=utf-8")
        response))))
(defn- rewrite-design-uris [handler]
  (fn [{:keys [uri] :as request}]
    (if (some true? (map #(.startsWith uri (str "/design/" %))
                         ["css" "javascripts" "images" "js" "favicon.ico"]))
      (handler (assoc request :uri (.substring uri 7)))
      (handler request))))

Parse a string into a seq of Enlive nodes.

We need to use this instead of Enlive's html-snippet, because html-snippet throws away the doctype

(defn- html-parse
  [s]
  (html/html-resource (java.io.StringReader. s)))

Accepts the selected menu (a keyword) and the response and returns an updated response body with the correct menu activated.

(defn- active-menu-transform
  [menu response]
  (assoc response
    :body (render (html/transform (html-parse (:body response))
                                  [:ul#navigation (keyword (str "li." (name menu)))]
                                  (html/add-class "active")))))

Middleware which will highlight the current active menu item.

(defn- set-active-menu
  [handler]
  (fn [request]
    (let [response (handler request)
          uri (:uri request)]
      (cond (= uri "/") (active-menu-transform :home response)
            (and (.startsWith uri "/design") (.endsWith uri ".html")) (active-menu-transform :design response)
            (= uri "/development") (active-menu-transform :development response)
            (= uri "/production") (active-menu-transform :production response)
            :else response))))
(def ^:private app (-> app-routes
                       (reload/watch-cljs config)
                       (wrap-file "public")
                       rewrite-design-uris
                       wrap-file-info
                       apply-templates
                       js-encoding
                       wrap-params
                       set-active-menu
                       wrap-stacktrace
                       (reload/reload-clj (:reload-clj config))))

Start the development server on port 8080.

(defn run-server
  []
  (run-jetty (var app) {:join? false :port 8080}))
 

one.host-page

toc

Functions to create an HTML page that hosts a ClojureScript application.

(ns one.host-page
  (:use [one.templates :only (construct-html render)])
  (:require [net.cgrand.enlive-html :as html]))
(def ^:private script-snippet
  (html/html-snippet "<script type='text/javascript'></script>"))
(defn- script
  [f]
  (html/transform script-snippet [:script] f))
(defn- application-view
  [& scripts]
  (html/transform (construct-html (html/html-resource "application.html"))
                  [:body]
                  (apply html/append scripts)))

Given a configuration map and an environment, return HTML (as a string) that can host a ClojureScript application. The environment must be either :development or :production - any other value results in an exception. The generated HTML is based on the contents of application.html, which is loaded as an Enlive resource.

In production mode, the HTML (as a sequence of Enlive nodes) is transformed via the :prod-transform function from the config map.

This function is normally called in two situations:

  1. From a Ring application to dynamically generate the application HTML.

  2. From the build script to create static deployment artifacts.

(defn application-host
  [config environment]
  (render
   (case environment
     :development
     (apply application-view (script (html/set-attr :src "javascripts/out/goog/base.js"))
            (script (html/set-attr :src "javascripts/main.js"))
            (map #(script (html/content %)) (:dev-js config)))
     :production
     (let [tfn (get config :prod-transform identity)]
       (tfn (apply application-view
                   (script (html/set-attr :src (str "javascripts/"
                                                    (:prod-js-file-name config))))
                   (map #(script (html/content %)) (:prod-js config)))))
     :fresh
     (apply application-view (script (html/set-attr :src "javascripts/out/goog/base.js"))
            (script (html/set-attr :src "javascripts/fresh.js"))
            (script (html/content "goog.require('one.browser.repl_client');"))
            (script (html/content "one.browser.repl_client.repl();"))))))
 

one.reload

toc

Contains functions which implement Clojure and ClojureScript code reloading.

When any watched Clojure file changes, all watched Clojure files will be recompiled. If any ClojureScript file changes or if any template file changes, all ClojureScript files will be recompiled.

Recompilation only happens on page reloads.

(ns one.reload
  (:use [cljs.closure :only (build)]
        [one.config])
  (:require [clojure.java.io :as io]))
(defonce ^:private
  last-compile (atom {}))
(defn- any-modified
  [k files]
  (let [newest (apply max
                      (map #(.lastModified %) files))]
    (when (> newest (get @last-compile k 0))
      newest)))

Return a seq of File objects that are descendants of dir that end with extension ext.

(defn- descendants-ending-with
  [dir ext]
  (filter #(.endsWith (.getName %) ext) (file-seq (io/file dir))))
(defn- any-modified-cljs
  [dir k]
  (let [files (filter #(.isFile %) (into (descendants-ending-with dir ".cljs")
                                         (file-seq (io/file "templates"))))]
    (any-modified k files)))

Ring middleware which watches dir for changes to ClojureScript source files and template HTML files. When changes are detected, recompiles only the ClojureScript and template files (not the Clojure files) using a build configuration derived from config.

(defn watch-cljs 
  [handler config]
  (fn [request]
    (let [k (:uri request)
          ts (any-modified-cljs (:src-root config) k)]
      (when ts
        (swap! last-compile assoc k ts)
        (let [build-opts (cljs-build-opts config)]
          (doseq [file (file-seq (io/file (str (:output-dir build-opts) "/"
                                               (:top-level-package config))))]
            (.setLastModified file 0))
          (build (:app-root config) (cond (= (:uri request) "/production")
                                          (assoc build-opts :optimizations :advanced
                                                 :output-to (production-js config))
                                          (= (:uri request) "/fresh")
                                          (assoc build-opts :output-to (str (:js config) "/fresh.js"))
                                          :default build-opts)))))
    (handler request)))
(defn- any-modified-clj
  [files]
  (any-modified "clj"
                (map #(-> (str % ".clj")
                          (.substring 1)
                          io/resource
                          (.getFile)
                          io/file)
                     files)))

Ring middleware which watches a list of Clojure files for changes and recompiles all of them when any of the files change.

(defn reload-clj
  [handler files]
  (fn [request]
    (when-let [ts (any-modified-clj files)]
      (swap! last-compile assoc "clj" ts)
      (let [ns (ns-name *ns*)]
        (apply load files)))
    (handler request)))
 

one.templates

toc

Contains functions for combining HTML fragments into complete HTML documents.

(ns one.templates
  (:use net.cgrand.enlive-html)
  (:import java.io.File))

Given a seq of Enlive nodes, return the corresponding HTML string.

(defn render
  [t]
  (apply str (emit* t)))
(declare construct-html)
(defn- html-body [name]
  (:content (first (select (html-resource name) [:body]))))
(defn- include-html [h]
  (let [includes (select h [:_include])]
    (loop [h h
           includes (seq includes)]
      (if includes
        (let [file (-> (first includes) :attrs :file)
              include (construct-html (html-body file))]
          (recur (transform h [[:_include (attr= :file file)]] (substitute include))
                 (next includes)))
        h))))
(defn- maps [c] (filter map? c))
(defn- replace-html [h c]
  (let [id (-> c :attrs :id)
        tag (:tag c)
        selector (keyword (str (name tag) "#" id))]
    (transform h [selector] (substitute c))))
(defn- wrap-html [h]
  (let [within (seq (select h [:_within]))]
    (if within
      (let [file (-> (first within) :attrs :file)
            outer (construct-html (html-resource file))
            content (maps (:content (first within)))]
        (loop [outer outer
               content (seq content)]
          (if content
            (recur (replace-html outer (first content)) (next content))
            outer)))
      h)))

Process a seq of Enlive nodes looking for _include and _within tags. Occurrences of _include are replaced by the resource to which they refer. The contents of _within tags are inserted into the resource to which they refer. _within is always the top-level tag in a file. _include can appear anywhere. Files with _include can reference files which themselves contain _include or _within tags, to an arbitrary level of nesting.

For more information, see 'Design and Templating' in the project wiki.

Returns a seq of Enlive nodes.

(defn construct-html
  [nodes]
  (wrap-html (include-html nodes)))

Accept a file (a path to a resource on the classpath) and return a HTML string processed per construct-html.

(defn load-html
  [file]
  (render (construct-html (html-resource file))))

Ring middleware which intercepts files served from the public directory and applies templating.

(defn apply-templates
  [handler]
  (fn [request]
    (let [{:keys [headers body] :as response} (handler request)]
      (if (and (= (type body) File)
               (.endsWith (.getName body) ".html"))
        (let [new-body (render (construct-html (html-snippet (slurp body))))]
          {:status 200
           :headers {"Content-Type" "text/html; charset=utf-8"}
           :body new-body})
        response))))
 

one.test

toc

Support for evaluating ClojureScript code from Clojure tests.

(ns one.test
  (:refer-clojure :exclude [load-file])
  (:require [cljs.repl.browser :as browser])
  (:use [cljs.compiler :only (namespaces)]
        [cljs.repl :only (evaluate-form load-file load-namespace)]
        [clojure.java.browse :only (browse-url)]
        [cljs.repl :only (-setup -tear-down)]
        [one.dev-server :only (run-server)]))
(def ^:dynamic *eval-env*)

Evaluate a ClojureScript form within the given evaluation environment. The form will also be evaluated in the passed namespace which defaults to 'cljs.user.

(defn evaluate-cljs
  ([eval-env form]
     (evaluate-cljs eval-env 'cljs.user form))
  ([eval-env ns form]
     (let [env {:context :statement :locals {}}]
       (cond
        (and (seq? form) ('#{load-file clojure.core/load-file} (first form)))
        (load-file eval-env (second form))
        (and (seq? form) ('#{load-namespace} (first form)))
        (load-namespace eval-env (second form))
        :else
        (let [ret (evaluate-form eval-env
                                 (assoc env :ns (@namespaces ns))
                                 "<testing>"
                                 form
                                 (fn [x] `(cljs.core.pr-str ~x)))]
          (try (read-string ret)
               (catch Exception e
                 (if (string? ret)
                   ret
                   nil))))))))

Using evaluation environment eval-env evaluate form in namespace ns in the browser until pred applied to the result returns true or the timeout expires. If pred returns logical true, returns the result of pred. Throws Exception if the timeout (in milliseconds) has expired.

(defn cljs-wait-for*
  [eval-env pred ns form remaining]
  (if (pos? remaining)
    (if-let [result (pred (evaluate-cljs eval-env ns form))]
      result
      (do (Thread/sleep 10)
          (recur eval-env pred ns form (- remaining 10))))
    (throw (Exception.
            (str "Form "
                 form
                 " did not satisfy predicate before the timeout expired.")))))

Expands to a call to cljs-wait-for* using *eval-env* as the evaluation environment and a timeout of roughly one minute.

(defmacro cljs-wait-for
  [pred ns form]
  `(cljs-wait-for* *eval-env* ~pred (quote ~ns) (quote ~form) 60000))

Ensure that that browser has completely loaded namespace ns. We need this because in some situations, we wind up trying to run code that depends on a namespace that isn't available yet, due to asynchrony in the browser. Returns true if the namespace loads within the specified timeout (roughly 60 seconds by default), and throws Exception otherwise.

(defn ensure-ns-loaded
  ([eval-env ns] (ensure-ns-loaded eval-env ns 60000))
  ([eval-env ns remaining]
     (if (pos? remaining)
       (if (evaluate-cljs eval-env (list 'boolean ns))
         true
         (do (Thread/sleep 10)
             (recur eval-env ns (- remaining 10))))
       (throw (Exception. (str "Namespace " ns " did not load before the timeout expired."))))))

Evaluate forms in namespace ns in the evaluation environment *eval-env*.

(defmacro cljs-eval
  [ns & forms]
  `(do
     (ensure-ns-loaded *eval-env* (quote ~ns))
     ~@(map (fn [x] `(evaluate-cljs *eval-env* (quote ~ns) (quote ~x))) forms)))

Evaluate f with one.test/*eval-env* bound to a browser evaluation environment. Opens a browser window and navigates to url which defaults to 'http://localhost:8080/development'.

(defn within-browser-env
  ([f] (within-browser-env "http://localhost:8080/development" nil f))
  ([url init f]
     (let [server (run-server)
           eval-env (browser/repl-env)]
       (-setup eval-env)
       (browse-url url)
       (binding [*eval-env* eval-env]
         (when init (init))
         (f))
       (-tear-down eval-env)
       (.stop server))))

Set up the ClojureScript testing namespace. This will arrange for all tests to be run in the provided namespace within the provided evaluation environment. This must appear only once per Clojure namespace and before any calls to js-defn or js.

This macro will define the vars, js-test-namespace and js-functions, in the calling namespace.

(defmacro js-ns
  [ns env-fn url]
  `(do (def ~'js-test-namespace (quote ~ns))
       (def ~'js-functions (atom []))
       (~'use-fixtures :once (partial ~env-fn ~url
                                    (fn [] (do (cljs-eval cljs.user (~'load-namespace (quote ~ns)))
                                              (doseq [f# @~'js-functions]
                                                (f#))))))))

Get the symbol for the current testing namespace.

(defn- test-namespace
  []
  (let [test-ns-var (symbol (str *ns*) "js-test-namespace")]
    (var-get (find-var test-ns-var))))

Define a ClojureScript function in the test namespace in the current JavaScript evaluation environment.

All ClojureScript functions will be loaded before tests are run.

(defmacro js-defn
  [name & body]
  (let [[doc-string args & body] (if (string? (first body))
                                   body
                                   (conj body ""))]
    `(swap! ~'js-functions conj
          (fn [] (cljs-eval ~(test-namespace) (defn ~name ~args ~@body))))))

Accepts a form and evaluates it in the current testing namespace and evaluation environment.

(defmacro js
  [form]
  `(cljs-eval ~(test-namespace) ~form))
 

one.tools

toc

Support for building deployment artifacts for a project.

(ns one.tools
  (:use [cljs.closure :only (build)]
        [one.host-page :only (application-host)]
        [one.config :only (cljs-build-opts production-js)]
        [cljs.repl :only (repl)]
        [cljs.repl.browser :only (repl-env)])
  (:require [clojure.java.io :as io]))

Emit both a JavaScript file containing the compiled ClojureScript application and the host HTML page.

(defn build-project
  [config]
  (build (:app-root config) (assoc (cljs-build-opts config)
                              :optimizations :advanced
                              :output-to (str "out/" (production-js config))))
  (spit "out/public/index.html" (application-host config :production)))

Start a ClojureScript REPL which can connect to the development version of the application. The REPL will not work until the development page connects to it, so you will need to either open or refresh the development page after calling this function.

(defn cljs-repl
  []
  (repl (repl-env)))

Recursively copy the files in src to dest.

(defn copy-recursive-into
  [src dest]
  (doseq [file (remove #(.isDirectory %) (file-seq (io/file src)))]
    (let [dest-file (io/file dest file)]
      (.mkdirs (.getParentFile dest-file))
      (io/copy file dest-file))))

Delete one or more files or directories. Directories are recursively deleted.

(defn delete
  [& paths]
  (doseq [path paths
          file (reverse (file-seq (io/file path)))]
    (.delete file)))
 

script.docs

toc

Provides a -main function which will generate the documentation for the website, the documentation that you are viewing at this very moment.

(ns script.docs
  (:require [net.cgrand.enlive-html :as html]
            [clojure.java.io :as io]))

Accepts a relative path for an HTML file and returns the body content from that file.

(defn- uberdoc-content
  [file]
  (-> (io/file file)
      html/html-resource
      (html/select [:body])
      first
      :content))

Accepts the relative path for the documentation template file and the margenalia content and returns the documentation page for the website.

(defn- docs
  [template marg]
  (-> (io/file template)
      html/html-resource
      (html/transform [:div#marginalia-documentation]
                      (html/substitute marg))))

Create the documentation.html page for the website. Outputs this file as docs/documentation.html.

(defn -main
  []
  (let [marg (uberdoc-content "docs/uberdoc.html")
        docs (docs "script/documentation.html" marg)]
    (spit "docs/documentation.html"
          (apply str (html/emit* docs)))))
 

one.sample.animation

toc

Defines animations which are used in the sample application.

(ns 
  one.sample.animation
  (:use [one.core :only (start)]
        [one.browser.animation :only (bind parallel serial play play-animation)]
        [domina :only (by-id set-html! set-styles! destroy-children! append! single-node)]
        [domina.xpath :only (xpath)])
  (:require [goog.dom.forms :as gforms]
            [goog.style :as style]))
(def form "//div[@id='form']")
(def cloud "//div[@id='greeting']")
(def label "//label[@id='name-input-label']/span")
(def ^:private
  form-in {:effect :fade :start 0 :end 1 :time 800})

Accepts the form and greeting view HTML and adds them to the page. Animates the form sliding in from above. This function must be run before any other view functions. It may be called from any state to reset the UI.

(defn initialize-views
  [form-html greeting-html]
  (let [content (xpath "//div[@id='content']")]
    (destroy-children! content)
    (set-html! content form-html)
    (append! content greeting-html)
    ;; Required for IE8 to work correctly
    (style/setOpacity (single-node (xpath label)) 1)
    (set-styles! (xpath cloud) {:opacity "0" :display "none" :margin-top "-500px"})
    (set-styles! (by-id "greet-button") {:opacity "0.2" :disabled true})
    (play form form-in {:after #(.focus (by-id "name-input") ())})))
(comment ;; Try it

  (initialize-views (:form one.sample.view/snippets)
                    (:greeting one.sample.view/snippets))
  
  )

Move the passed input field label above the input field. Run when the field gets focus and is empty.

(defn label-move-up
  [label]
  (play label [{:effect :color :end "#53607b" :time 200}
               {:effect :slide :up 40 :time 200}]))

Make the passed input field label invisible. Run when the input field loses focus and contains a valid input value.

(defn label-fade-out
  [label]
  (play label {:effect :fade :end 0 :time 200}))
(def move-down [{:effect :fade :end 1 :time 200}
                {:effect :color :end "#BBC4D7" :time 200}
                {:effect :slide :down 40 :time 200}])
(def fade-in {:effect :fade :end 1 :time 400})
(def fade-out {:effect :fade :end 0 :time 400})

Make the passed input field label visible and move it down into the input field. Run when an input field loses focus and is empty.

(defn label-move-down
  [label]
  (play label move-down))
(comment ;; Examples of label effects.
  
  (label-move-up label)
  (label-fade-out label)
  (label-move-down label)
  )

Move the form out of view and the greeting into view. Run when the submit button is clicked and the form has valid input.

(defn show-greeting
  []
  (let [e {:effect :fade :end 0 :time 500}]
    (play-animation #(parallel (bind form e)
                               (bind label e) ; Since the label won't fade in IE
                               (bind cloud
                                     {:effect :color :time 500} ; Dummy animation for delay purposes
                                     {:effect :fade-in-and-show :time 600}))
                    {:before #(gforms/setDisabled (by-id "name-input") true)
                     ;; We need this next one because IE8 won't hide the button
                     :after #(set-styles! (by-id "greet-button") {:display "none"})})))

Move the greeting cloud out of view and show the form. Run when the back button is clicked from the greeting view.

(defn show-form
  []
  (play-animation (serial (parallel (bind cloud {:effect :fade-out-and-hide :time 500})
                                    (bind form
                                          {:effect :color :time 300} ; Dummy animation for delay purposes
                                          form-in)
                                    (bind label fade-in move-down)))
                  {;; Because IE8 won't hide the button, we need to
                   ;; toggle it between displaying inline and none
                   :before #(set-styles! (by-id "greet-button") {:display "inline"})
                   :after #(do
                             (gforms/setDisabled (by-id "name-input") false)
                             (.focus (by-id "name-input") ()))}))
(comment ;; Switch between greeting and form views

  (label-move-up label)
  (show-greeting)
  (show-form)
  )

Accepts an element id for a button and disables it. Fades the button to 0.2 opacity.

(defn disable-button
  [id]
  (let [button (by-id id)]
    (gforms/setDisabled button true)
    (play button {:effect :fade :end 0.2 :time 400})))

Accepts an element id for a button and enables it. Fades the button to an opactiy of 1.

(defn enable-button
  [id]
  (let [button (by-id id)]
    (gforms/setDisabled button false)
    (play button fade-in)))
(comment ;; Examples of all effects

  (initialize-views (:form one.sample.view/snippets)
                    (:greeting one.sample.view/snippets))
  (label-move-up label)
  (label-fade-out label)
  (show-greeting)
  (show-form)

  (disable-button "greet-button")
  (enable-button "greet-button")
  )
 

one.sample.controller

toc

Respond to user actions by updating local and remote application state.

(ns 
  one.sample.controller
  (:use [one.browser.remote :only (request)]
        [one.sample.model :only (state)])
  (:require [cljs.reader :as reader]
            [clojure.browser.event :as event]
            [one.dispatch :as dispatch]
            [goog.uri.utils :as uri]))

Accepts a map containing information about an action to perform.

Actions may cause state changes on the client or the server. This function dispatches on the value of the :type key and currently supports :init, :form, and :greeting actions.

The :init action will initialize the appliation's state.

The :form action will only update the status atom, setting its state to :from.

The :greeting action will send the entered name to the server and update the state to :greeting while adding :name and :exists values to the application's state.

(defmulti action
  :type)
(defmethod action :init [_]
  (reset! state {:state :init}))
(defmethod action :form [_]
  (when-not (#{:form :init} (:state @state))
    (swap! state assoc :state :form)))

Get the name of the host which served this script.

(defn host
  []
  (uri/getHost (.toString window.location ())))

Accepts a function id (an identifier for this request), data (the data to send to the server) and a callback function which will be called if the transmission is successful. Perform an Ajax POST request to the backend API which sends the passed data to the server.

A tranmission error will add an error message to the application's state.

(defn remote
  [f data on-success]
  (request f (str (host) "/remote")
           :method "POST"
           :on-success #(on-success (reader/read-string (:body %)))
           :on-error #(swap! state assoc :error "Error communicating with server.")
           :content (str "data=" (pr-str {:fn f :args data}))))

This is the success callback function which will be called when a request is successful. Accepts a name and a map of response data. Sets the current state to :greeting and adds the :name and :exists values to the application's state.

(defn add-name-callback
  [name response]
  (swap! state (fn [old]
                 (assoc (assoc old :state :greeting :name name)
                   :exists (boolean (:exists response))))))
(defmethod action :greeting [{name :name}]
  (remote :add-name {:name name} #(add-name-callback name %)))
(dispatch/react-to #{:init :form :greeting}
                   (fn [t d] (action (assoc d :type t))))
 

one.sample.core

toc

Contains the entry point for the ClojureScript sample application.

(ns 
  one.sample.core
  (:require [one.browser.repl-client :as repl-client]
            [one.dispatch :as dispatch]
            [one.sample.view :as view]))

Connects to a ClojureScript REPL running on localhost port 9000.

This allows a browser-connected REPL to send JavaScript to the browser for evaluation. This function should be called from a script in the development host HTML page.

(defn ^:export repl
  []
  (repl-client/repl))

Start the application by firing a :init event which will cause the form view to be displayed.

This function must be called from the host HTML page to start the application.

(defn ^:export start
  []
  (dispatch/fire :init))
 

one.sample.history

toc

When this library is loaded, a listener function is added which will be run when a :form or :greeting event is fired. This allows the use of the back button to navigate between views. This is accomplished by using library.browser.history to keep track of views that have previously been visited, and traversing them when navigation events are detected.

(ns 
  one.sample.history
  (:require [one.dispatch :as dispatch]
            [one.browser.history :as history]))

Handle navigation events by firing the appropriate view token.

(defn nav-handler
  [{:keys [token navigation?]}]
  (when navigation?
    (dispatch/fire token)))

The global history object for this application.

(def 
  history (history/history nav-handler))
(dispatch/react-to #{:init :form :greeting}
                   (fn [t _]
                     (history/set-token history (if (#{:init} t) :form t))))
 

one.sample.logging

toc

When this library is loaded, create a logger named 'events' and send all application-specific events to it.

To view log messages in the browser console, add a call to (log/console-output) to this namespace or evaluate this from the REPL.

For more information see library.logging.

(ns 
  one.sample.logging
  (:require [one.dispatch :as dispatch]
            [one.logging :as log]))

The logger that receives all application-specific events.

(def 
  logger (log/get-logger "events"))
(dispatch/react-to (constantly true)
                   (fn [t d] (log/info logger (str (pr-str t) " - " (pr-str d)))))
(comment
  ;; log to the console
  (log/start-display (log/console-output))
  ;; log to to the "fancy" window
  (log/start-display (log/fancy-output "main"))
  ;; change the logging level
  (log/set-level logger :fine)
  )
 

one.sample.model

toc

Contains client-side state, validators for input fields and functions which react to changes made to the input fields.

(ns 
 one.sample.model
  (:require [one.dispatch :as dispatch]))

An atom containing a map which is the application's current state.

(def 
  state (atom {}))
(add-watch state :state-change-key
           (fn [k r o n]
             (dispatch/fire :state-change n)))

An atom containing the state of the greeting form and each of its fields.

(def ^{:private true
       :doc }
  greeting-form (atom {}))
(add-watch greeting-form :form-change-key
           (fn [k r o n]
             (dispatch/fire :form-change {:old o :new n})))
(defmulti ^:private new-status
  (fn [& args] (vec args)))
(def error-status
  {:status :error
   :error "Are you sure about that? Names must have at least two characters."})
(def editing-error-status
  {:status :editing-error
   :error "Names must have at least two characters."})
(defmethod new-status [:empty :focus :empty] [p e f]
  {:status :editing})
(defmethod new-status [:editing :finished :empty] [p e f]
  {:status :empty})
(defmethod new-status [:editing :change :empty] [p e f]
  {:status :editing})
(defmethod new-status [:editing :change :error] [p e f]
  {:status :editing})
(defmethod new-status [:editing :change :valid] [p e f]
  {:status :editing-valid})
(defmethod new-status [:editing :finished :error] [p e f]
  error-status)
(defmethod new-status [:editing-valid :change :error] [p e f]
  {:status :editing})
(defmethod new-status [:editing-valid :change :valid] [p e f]
  {:status :editing-valid})
(defmethod new-status [:editing-valid :finished :valid] [p e f]
  {:status :valid})
(defmethod new-status [:error :focus :error] [p e f]
  editing-error-status)
(defmethod new-status [:editing-error :change :error] [p e f]
  editing-error-status)
(defmethod new-status [:editing-error :finished :error] [p e f]
  error-status)
(defmethod new-status [:editing-error :change :valid] [p e f]
  {:status :editing-valid})
(defmethod new-status [:editing-error :change :empty] [p e f]
  {:status :editing-error})
(defmethod new-status [:editing-error :finished :empty] [p e f]
  {:status :empty})
(defmethod new-status [:valid :focus :valid] [p e f]
  {:status :editing-valid})
(defmethod new-status [:valid :finished :empty] [p e f]
  {:status :empty})
(defmethod new-status :default [p e f]
  {:status p})

Accepts a form id and a value and returns a map with :value, :status, and :error keys. Status will be set to either :valid or :error. If there was an error, then there will be an error message associated with the :error key.

(defmulti ^:private validate
  (fn [id _] id))
(defmethod validate "name-input" [_ v]
  (cond (= (count v) 0) :empty
        (= (count v) 1) :error
        :else :valid))

Calculates the status of the whole form based on the status of each field. Retuns :finished or :editing.

(defn- form-status
  [m]
  (if (every? #(or (= % :valid) (= % :editing-valid)) (map :status (vals (:fields m))))
    :finished
    :editing))

Accepts a field-id and value. Validates the field and updates the greeting form atom.

(defn- set-field-value
  [field-id type value]
  (swap! greeting-form
         (fn [old]
           (let [field (get (:fields old) field-id {})
                 field-status (assoc (new-status (-> old :fields field-id :status)
                                                 type
                                                 (validate field-id value))
                                :value value)
                 new (assoc-in old [:fields field-id] field-status)]
             (assoc new :status (form-status new))))))

Update the form state for a given field to indicate that the form is still being edited.

(defn- set-editing
  [id]
  (swap! greeting-form
         (fn [old]
           (let [field-map (-> old :fields id)
                 status (or (:status field-map) :empty)
                 field-status (new-status status
                                          :focus
                                          status)]
             (-> old
                 (assoc-in [:fields id] (assoc field-status :value (:value field-map)))
                 (assoc :status (form-status old)))))))
(dispatch/react-to (fn [e] (= (first e) :field-finished))
                   (fn [[_ id] value]
                     (set-field-value id :finished value)))
(dispatch/react-to (fn [e] (= (first e) :field-changed))
                   (fn [[_ id] value]
                     (set-field-value id :change value)))
(dispatch/react-to (fn [e] (= (first e) :editing-field))
                   (fn [[_ id] _]
                     (set-editing id)))
(dispatch/react-to #{:form-submit}
  (fn [t d]
    (let [form-data @greeting-form]
      (when (= (:status form-data) :finished)
        (dispatch/fire :greeting {:name (-> form-data :fields "name-input" :value)})))))
 

one.sample.view

toc

Render the views for the application.

(ns 
  one.sample.view
  (:use [domina :only (set-html! set-styles! styles by-id set-style!
                       by-class value set-value! set-text! nodes single-node)]
        [domina.xpath :only (xpath)]
        [one.browser.animation :only (play)])
  (:require-macros [one.sample.snippets :as snippets])
  (:require [goog.events.KeyCodes :as key-codes]
            [goog.events.KeyHandler :as key-handler]
            [clojure.browser.event :as event]
            [one.dispatch :as dispatch]
            [one.sample.animation :as fx]))

A map which contains chunks of HTML which may be used when rendering views.

(def 
  snippets (snippets/snippets))

Render the submit button based on the current state of the form. The button is disabled while the user is editing the form and becomes enabled when the form is complete.

(defmulti render-button
  identity)
(defmethod render-button :default [_])
(defmethod render-button [:finished :editing] [_]
  (fx/disable-button "greet-button"))
(defmethod render-button [:editing :finished] [_]
  (fx/enable-button "greet-button"))

Render a form field based on the current state transition. Form fields are validated as soon as they lose focus. There are six transitions and each one has its own animation.

(defmulti render-form-field
  :transition)
(defmethod render-form-field :default [_])

Accepts an element id for an input field and return the xpath string to the label for that field.

(defn- label-xpath
  [id]
  (str "//label[@id='" id "-label']/span"))
(defmethod render-form-field [:empty :editing] [{:keys [id]}]
  (fx/label-move-up (label-xpath id)))
(defmethod render-form-field [:editing :empty] [{:keys [id]}]
  (fx/label-move-down (label-xpath id)))
(defmethod render-form-field [:editing-valid :valid] [{:keys [id]}]
  (fx/label-fade-out (label-xpath id)))
(defmethod render-form-field [:valid :editing-valid] [{:keys [id]}]
  (play (label-xpath id) fx/fade-in))
(defmethod render-form-field [:editing :error] [{:keys [id error]}]
  (let [error-element (by-id (str id "-error"))]
    (set-style! error-element "opacity" "0")
    (set-html! error-element error)
    (play error-element fx/fade-in)))

Accepts an id and an error message and fades the old error message out and the new one in.

(defn- swap-error-messages
  [id error]
  (let [error-element (by-id (str id "-error"))]
    (play error-element fx/fade-out
             {:name "fade out error"})
    (play error-element fx/fade-in {:before #(set-html! error-element error)})))
(defmethod render-form-field [:error :editing-error] [{:keys [id error]}]
  (swap-error-messages id error))
(defmethod render-form-field [:editing-error :error] [{:keys [id error]}]
  (swap-error-messages id error))
(defmethod render-form-field [:editing-error :editing-valid] [{:keys [id]}]
  (let [error-element (by-id (str id "-error"))]
    (play error-element (assoc fx/fade-out :time 200))))
(defmethod render-form-field [:editing-error :empty] [{:keys [id]}]
  (let [error-element (by-id (str id "-error"))]
    (play error-element (assoc fx/fade-out :time 200))
    (fx/label-move-down (label-xpath id))))

Accepts a field-id and creates listeners for blur and focus events which will then fire :field-changed and :editing-field events.

(defn- add-input-event-listeners
  [field-id]
  (let [field (by-id field-id)
        keyboard (goog.events.KeyHandler. (by-id "form"))]
    (event/listen field
                  "blur"
                  #(dispatch/fire [:field-finished field-id] (value field)))
    (event/listen field
                  "focus"
                  #(dispatch/fire [:editing-field field-id]))
    (event/listen field
                  "keyup"
                  #(dispatch/fire [:field-changed field-id] (value field)))
    (event/listen keyboard
                  "key"
                  (fn [e] (when (= (.-keyCode e) key-codes/ENTER)
                           (do (.blur (by-id "name-input") ())
                               (dispatch/fire :form-submit)))))))

Accepts a map which represents the current state of the application and renders a view based on the value of the :state key.

(defmulti render
  :state)
(defmethod render :init [_]
  (fx/initialize-views (:form snippets) (:greeting snippets))
  (add-input-event-listeners "name-input")
  (event/listen (by-id "greet-button")
                "click"
                #(dispatch/fire :greeting
                                {:name (value (by-id "name-input"))})))
(defmethod render :form [{:keys [state error name]}]
  (fx/show-form)
  (set-value! (by-id "name-input") "")
  (dispatch/fire [:field-finished "name-input"] ""))
(defmethod render :greeting [{:keys [state name exists]}]
  (set-text! (single-node (by-class "name")) name)
  (set-text! (single-node (by-class "again")) (if exists "again" ""))
  (fx/show-greeting))
(dispatch/react-to #{:state-change} (fn [_ m] (render m)))

Given a map of old and new form states, generate a map with :id, :transition and :error keys which can be passed to render-form-field.

(defn- form-fields-status
  [m]
  (map #(hash-map :id %
                  :transition [(or (-> m :old :fields % :status) :empty)
                               (-> m :new :fields % :status)]
                  :error (-> m :new :fields % :error))
       (keys (-> m :new :fields))))
(dispatch/react-to #{:form-change}
                   (fn [_ m]
                     (doseq [s (form-fields-status m)]
                       (render-form-field s))
                     (render-button [(-> m :old :status)
                                     (-> m :new :status)] )))
 

one.browser.animation

toc

Provides support for basic animations. Allows effects to be represented as Clojure data.

(ns 
  one.browser.animation
  (:use [one.color :only (color bg-color rgb IColorSource)]
        [one.core :only (start dispose get-style)])
  (:require [goog.style :as style]
            [goog.string :as gstring]
            [goog.fx.AnimationQueue :as queue]
            [goog.fx.easing :as easing]
            [goog.fx.dom :as anim]
            [goog.async.Delay :as delay]
            [clojure.browser.event :as event]
            [clojure.browser.dom :as dom]
            [domina :as d]
            [domina.xpath :as dx]))
(def ^:dynamic *default-time* 1000)

Accepts a keyword, string or element and returns an element. Strings are assumed to be xpath format.

(defn- get-element
  [e]
  (cond (keyword? e) (d/by-id (name e))
        (string? e) (first (d/nodes (dx/xpath e)))
        :else e))
(defprotocol IPosition
  (position [this] "Return the position of the passed object as a 2D array, `[X Y]`."))
(extend-protocol IPosition

  cljs.core.Vector
  (position [this] this)

  js/Array
  (position [this] (js->clj this))

  js/Element
  (position [this]
    (let [p (js->clj (style/getPosition this) :keywordize-keys true)]
      [(:x p) (:y p)])))
(defprotocol IScroll
  (scroll [this] "Return the scroll position of an element as `[X Y]`."))
(extend-protocol IScroll

  js/Number
  (scroll [this] [0 this])

  cljs.core.Vector
  (scroll [this] this)

  js/Element
  (scroll [this]
    [(.-scrollLeft this) (.-scrollTop this)]))
(defprotocol ISize
  (size [this] "Return the size of an element as `[W H]`.")
  (width [this] "Return the width of an element.")
  (height [this] "Return the height of an element."))
(extend-protocol ISize

  js/Number
  (size [this] [this this])
  (width [this] this)
  (height [this] this)

  cljs.core.Vector
  (size [this] this)
  (width [this] (first this))
  (height [this] (second this))

  js/Element
  (size [this]
    (let [s (js->clj (style/getSize this)
                     :keywordize-keys true)]
      [(:width s) (:height s)]))
  (width [this]
    (width (size this)))
  (height [this]
    (height (size this))))
(defprotocol IOpacity
  (opacity [this] "Return the elements current opacity."))
(extend-protocol IOpacity

  js/String
  (opacity [this]
    (js/parseFloat this))

  js/Number
  (opacity [this] this)

  js/Element
  (opacity [this]
    (let [op (style/getComputedStyle this "opacity")]
      (if (= op "")
        (opacity (style/getOpacity this))
        op))))
(extend-type goog.fx.AnimationQueue
  
  one.core/Startable
  (start [this] (.play this ()))
  
  one.core/Disposable
  (dispose [this] (.dispose this ())))
(extend-type goog.fx.dom.PredefinedEffect
  
  one.core/Startable
  (start [this] (.play this ()))
  
  one.core/Disposable
  (dispose [this] (.dispose this ()))
  
  event/EventType
  (event-types [this]
    (into {}
          (map
           (fn [[k v]]
             [(keyword (. k (toLowerCase)))
              v])
           (merge (js->clj goog.fx.Animation.EventType))))))

Get the acceleration function associated with a given keyword. Implementing this as a multimethod allows developers to add new functions and still represent effects as data.

(defmulti acceleration
  identity :default :ease-out)
(defmethod acceleration :ease-out [name]
  easing/easeOut)
(defmethod acceleration :ease-in [name]
  easing/easeIn)
(defmethod acceleration :in-and-out [name]
  easing/inAndOut)

Given a map which represents an effect. Return the acceleration function or nil.

(defn- accel
  [m]
  (when-let [a (:accel m)]
    (if (fn? a)
      a
      (acceleration a))))
(defrecord Effect [effect start end time accel]
  one.color.IColorSource
  (color [this] (:end this))
  (bg-color [this] (:end this))
  IOpacity
  (opacity [this] (:end this))
  IPosition
  (position [this] (:end this))
  ISize
  (size [this] (:end this))
  (width [this] (width (:end this)))
  (height [this] (height (:end this)))
  IScroll
  (scroll [this] (:end this)))

Dispatch function for effect multimethods. Accepts an element and a map describing an effect and returns the effect name as a keyword.

(defn- effect-dispatch
  [_ {effect :effect}] effect)

Accepts an element and an effect map and returns a standardized effect map which must contain the four keys: :start, :end, :time and :accel.

The element argument can either be an HTML element or an effect map which describes the previous effect.

(defmulti standardize
  effect-dispatch)
(defmethod standardize :color [element m]
  (Effect. :color
           (color (or (:start m) element))
           (color (or (:end m) element))
           (or (:time m) *default-time*)
           (accel m)))

Accepts an element and a map and returns an effect. The returned effect may be run or composed with other effects.

Available effects include: :color, :fade, :fade-in, :fade-out, :fade-in-and-show, :fade-out-and-hide, :slide, :swipe, :bg-color, :resize, :resize-width and :resize-height.

(defmulti effect
  effect-dispatch)
(defmethod effect :color [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.ColorTransform. element
                                 (apply array (rgb start))
                                 (apply array (rgb end))
                                 time
                                 accel)))
(comment ;; Color effect examples
  (def label (get-element "//label[@id='name-input-label']/span"))
  (def label-color (color label))
  (def red [255 0 0])
  (def green [0 255 0])
  (start (effect label {:effect :color :end red}))
  (start (effect label {:effect :color :end green}))
  (start (effect label {:effect :color :end label-color}))
  (start (bind label
               {:effect :color :end red}
               {:effect :color :end green}
               {:effect :color :end label-color})))
(defmethod standardize :fade [element m]
  (Effect. :fade
           (opacity (or (:start m) element))
           (opacity (:end m))
           (or (:time m) *default-time*)
           (accel m)))
(defmethod effect :fade [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.Fade. element start end time accel)))
(defmethod standardize :fade-in [element m]
  (Effect. :fade-in 0 1 (or (:time m) *default-time*) (accel m)))
(defmethod effect :fade-in [element m]
  (let [{:keys [time accel]} (standardize element m)]
    (goog.fx.dom.FadeIn. element time accel)))
(defmethod standardize :fade-out [element m]
  (Effect. :fade-out 1 0 (or (:time m) *default-time*) (accel m)))
(defmethod effect :fade-out [element m]
  (let [{:keys [time accel]} (standardize element m)]
    (goog.fx.dom.FadeOut. element time accel)))
(defmethod standardize :fade-in-and-show [element m]
  (Effect. :fade-in-and-show 0 1 (or (:time m) *default-time*) (accel m)))
(defmethod effect :fade-in-and-show [element m]
  (let [{:keys [time accel]} (standardize element m)]
    (goog.fx.dom.FadeInAndShow. element time accel)))
(defmethod standardize :fade-out-and-hide [element m]
  (Effect. :fade-out-and-hide 1 0 (or (:time m) *default-time*) (accel m)))
(defmethod effect :fade-out-and-hide [element m]
  (let [{:keys [time accel]} (standardize element m)]
    (goog.fx.dom.FadeOutAndHide. element time accel)))
(comment ;; Fade effect examples
  (def label (get-element "//label[@id='name-input-label']/span"))
  (def title (get-element "//div[@id='form']/h1"))
  (def title-opacity (opacity title))
  (def label-opacity (opacity label))
  (start (effect label {:effect :fade :end 0.2}))
  (start (effect title {:effect :fade :end label}))
  (start (effect label {:effect :fade :end label-opacity}))
  (start (effect title {:effect :fade :end title-opacity}))
  (start (effect label {:effect :fade-out}))
  (start (effect label {:effect :fade-in}))
  (start (effect label {:effect :fade-out-and-hide}))
  (start (effect label {:effect :fade-in-and-show}))
  (start (bind label
               {:effect :fade :end 0 :time 2000}
               {:effect :fade :end 1 :time 2000}))
  ;; mix fade effects - cannot mix both fade-in-and-show and
  ;; fade-out-and-hide in the same animation.
  (start (apply bind label
                (map #(assoc % :time 2000)
                     [{:effect :fade-out}
                      {:effect :fade :end 1}
                      {:effect :fade :end 0}
                      {:effect :fade-in}
                      {:effect :fade :end 0}
                      {:effect :fade :end 1}]))))
(defmethod standardize :bg-color [element m]
  (let [start (or (:start m) element)
        end (or (:end m) element)]
    (Effect. :bg-color
             (bg-color start)
             (bg-color end)
             (or (:time m) *default-time*)
             (accel m))))
(defmethod effect :bg-color [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.BgColorTransform. element
                                   (apply array (rgb start))
                                   (apply array (rgb end))
                                   time
                                   accel)))
(comment ;; Background color effect examples
  (def input (get-element :name-input))
  (def red [255 0 0])
  (def green [0 255 0])
  (def input-bg-color (bg-color input))
  (def input-color (color input))
  (start (effect input {:effect :bg-color :end red}))
  (start (effect input {:effect :bg-color :end green}))
  (start (effect input {:effect :bg-color :end input-bg-color}))
  (start (bind input
               {:effect :bg-color :end red}
               {:effect :bg-color :end green}
               {:effect :bg-color :end input-bg-color})))

Calculate the end of a slide based on the start value and the passed :left, :right, :up and :down values.

(defn- calculate-slide-end
  [[x y] m]
  (vector (+ (- x (:left m 0)) (:right m 0))
          (+ (- y (:up m 0)) (:down m 0))))
(defmethod standardize :slide [element m]
  (let [start (position (or (:start m) element))
        end (or (:end m) (calculate-slide-end start m))]
    (Effect. :slide
             start
             end
             (or (:time m) *default-time*)
             (accel m))))
(defmethod effect :slide [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.Slide. element
                        (apply array start)
                        (apply array end)
                        time
                        accel)))
(comment ;; Slide effect examples
  (def label (get-element "//label[@id='name-input-label']/span"))
  (start (effect label {:effect :slide :up 40 :time 100}))
  (start (effect label {:effect :slide :down 40 :time 100}))
  ;; Easing examples
  (start (effect label {:effect :slide :up 200 :accel :ease-out}))
  (start (effect label {:effect :slide :down 200 :accel :ease-in}))
  ;; slide up and then down
  (start (bind label
               {:effect :slide :up 200 :time 2000 :accel :ease-out}
               {:effect :slide :down 200 :time 2000 :accel :ease-in})))
(defmethod standardize :resize-height [element m]
  (let [start (when-let [h (:start m)] [(width element) (height h)])
        end (when-let [h (:end m)] [(width element) (height h)])]
    (Effect. :resize-height
            (size (or start element))
            (size (or end element))
            (or (:time m) *default-time*)
            (accel m))))
(defmethod effect :resize-height [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.ResizeHeight. element (height start) (height end) time accel)))
(defmethod standardize :resize-width [element m]
  (let [start (when-let [w (:start m)] [(width w) (height element)])
        end (when-let [w (:end m)] [(width w) (height element)])]
    (Effect. :resize-width
            (size (or start element))
            (size (or end element))
            (or (:time m) *default-time*)
            (accel m))))
(defmethod effect :resize-width [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.ResizeWidth. element (width start) (width end) time accel)))
(defmethod standardize :resize [element m]
  (Effect. :resize
           (size (or (:start m) element))
           (size (or (:end m) element))
           (or (:time m) *default-time*)
           (accel m)))
(defmethod effect :resize [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.Resize. element
                         (apply array start)
                         (apply array end)
                         time
                         accel)))
(comment ;; Resize examples
  (def button (get-element :greet-button))
  (def button-size (size button))
  (def button-height (height button))
  (def button-width (width button))
  (start (effect button {:effect :resize :end [200 200]}))
  (start (effect button {:effect :resize :end button-size}))
  (start (effect button {:effect :resize-height :end 200}))
  (start (effect button {:effect :resize-height :end button-height}))
  (start (effect button {:effect :resize-width :end 200}))
  (start (effect button {:effect :resize-width :end button-width}))
  (start (bind button
               {:effect :resize :end [200 200]}
               {:effect :resize-height :end 300}
               {:effect :resize-width :end 300}
               {:effect :resize-height :end 200}
               {:effect :resize-width :end 200}
               {:effect :resize :end button-size})))
(defmethod standardize :scroll [element m]
  (let [start (or (:start m) element)
        end (:end m)]
    (Effect. :scroll
             (scroll start)
             (scroll end)
             (or (:time m) *default-time*)
             (accel m))))
(defmethod effect :scroll [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.Scroll. element
                         (apply array start)
                         (apply array end)
                         time
                         accel)))
(comment ;; Scroll examples
  (def doc (get-element "//body"))
  ;; Make the window small before trying this.
  (start (effect doc {:effect :scroll :end [500 500]}))
  (start (effect doc {:effect :scroll :end [0 0]}))
  (start (effect doc {:effect :scroll :end 300}))
  (start (effect doc {:effect :scroll :end 0}))
  (start (bind doc
               {:effect :scroll :end [500 500]}
               {:effect :scroll :end [0 0]}
               {:effect :scroll :end 300}
               {:effect :scroll :end 0})))
(defmethod standardize :swipe [element m]
  (let [start (or (:start m) [0 0])
        end (or (:end m) element)]
    (Effect. :swipe
             (size start)
             (size end)
             (or (:time m) *default-time*)
             (accel m))))
(defmethod effect :swipe [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.Swipe. element
                        (apply array start)
                        (apply array end)
                        time
                        accel)))
(comment ;; Swipe examples
  (def button (get-element :greet-button))
  (def button-size (size button))
  (style/setStyle button "position" "absolute")
  (start (effect button {:effect :swipe :start [100 0] :time 300}))
  (start (effect button {:effect :swipe :start [0 45] :time 300}))
  (start (effect button {:effect :swipe :time 300}))
  (style/setStyle button "position" ))

Cause the passed animations to run in parallel.

(defn parallel
  [& effects]
  (let [parallel (goog.fx.AnimationParallelQueue.)]
    (doseq [effect effects] (.add parallel effect))
    parallel))

Cause the passed animations to be run in order.

(defn serial
  [& effects]
  (let [serial (goog.fx.AnimationSerialQueue.)]
    (doseq [effect effects]
      (.add serial effect))
    serial))

Mapping of specific effects to a more general category of effect. For example, there are multiple size and opacity effects. Within a single animation, each type of effect should influence subsequent effects of the same type.

(def ^{:doc 
       :private true}
  effect-types
  {:color             :color
   :fade              :opacity
   :fade-in           :opacity
   :fade-out          :opacity
   :fade-in-and-show  :opacity
   :fade-out-and-hide :opacity
   :bg-color          :bg-color
   :slide             :position
   :resize            :size
   :resize-height     :size
   :resize-width      :size
   :scroll            :scroll
   :swipe             :size})

Standardize an effect within the scope of previous effects. Return a vector containing the new environment and the standardized effect. An effect may be a single map or a vector of maps

(defn- standardize-in-env
  [element env effect]
  (if (vector? effect)
    (let [coll (map #(standardize-in-env element env %) effect)]
      [(apply merge (map first coll)) (vec (map second coll))])
    (let [effect-type ((:effect effect) effect-types)
          effect (standardize (get env effect-type element) effect)
          env (assoc env effect-type effect)]
      [env effect])))

Accepts an element and a list of effects and vectors of effects and returns the same structure with all effect map standardized. Missing values will be calculated based on previous effects.

(defn- standardize-all-effects
  [element & effects]
  (loop [env {}
         effects effects
         std-effects []]
    (if (seq effects)
      (let [effect (first effects)
            [env effect] (standardize-in-env element env effect)]
        (recur env
               (rest effects)
               (conj std-effects effect)))
      std-effects)))

Bind effects to an element returning an animation. Accepts an HTML element and any number of effects. Effects can be Maps or a Vector of Maps. Each effect is run in order. Each effect within a Vector is run in parallel.

(defn bind
  [element & effects]
  (let [element (get-element element)
        effects (apply standardize-all-effects element effects)
        serial (goog.fx.AnimationSerialQueue.)]
    (doseq [sequential-effect effects]
      (if (vector? sequential-effect)
        (let [parallel (goog.fx.AnimationParallelQueue.)]
          (doseq [parallel-effect sequential-effect]
            (.add parallel (effect element parallel-effect)))
          (.add serial parallel))
        (.add serial (effect element sequential-effect))))
    serial))
(comment ;; Bind examples
  (def label-color (color (get-element "//label[@id='name-input-label']/span")))
  (def label (get-element "//label[@id='name-input-label']/span"))
  (def input (get-element :name-input))
  (def red [255 0 0])
  (def green [0 255 0])
  (def blue [0 0 255])
  (def input-bg-color (bg-color input))
  (def input-color (color input))
  (def button (get-element :greet-button))
  (def button-size (size button))
  (def move-label (bind label
                        [{:effect :slide :up 200 :time 2000}
                         {:effect :color :end red :time 2000}]
                        [{:effect :slide :down 200 :time 2000}
                         {:effect :color :end label-color :time 2000}]))
  (start move-label)
  (def background (bind input
                        {:effect :bg-color :end red}
                        {:effect :bg-color :end green}
                        {:effect :bg-color :end blue}
                        {:effect :bg-color :end input-bg-color}))
  (start background)
  ;; Serial and parallel animations on different elements
  (def big-button (bind button
                        {:effect :resize :end [200 200] :time 2000}
                        {:effect :resize :end button-size :time 2000}))
  (start big-button)
  (start (serial move-label background big-button))
  (start (parallel move-label background big-button)))
(comment ;; Events
  ;; You may listen for "begin" and "finish" events
  (def label-up (bind "//label[@id='name-input-label']/span"
                      {:effect :color :end "#53607b" :time 200}
                      {:effect :slide :up 40 :time 200}))
  (event/listen-once label-up
                     "finish"
                     #(js/alert "Animation finished."))
  (start label-up))

Source of unique animation ids.

(def ^{:doc 
       :private true}
  animation-id (atom 0))

Data structure which supports running animations sequentially which have been started by the play and play-animation functions.

(def ^{:doc 
       :private true}
  animation-queue (atom {:runner nil :running nil :next []}))

Add an animation to the animation-queue. If no runner is currently running animations then assign that job to the calling function by setting :runner to the passed id and putting the first animation to run under :running.

If a runner is already running then add this animation to the vector under :next.

(defn- add-to-queue
  [queue id animations]
  (let [new-next (conj (:next queue) animations)]
    (if (:runner queue)
      (assoc queue :next new-next)
      (assoc queue
        :runner id
        :running (first new-next)
        :next (vec (rest new-next))))))
(comment

  (add-to-queue {:runner nil :running nil :next []} 2 {:e 1 :a 2})
  (add-to-queue {:runner nil :running nil :next [{:e 1 :a 2}]} 2 {:e 3 :a 4})
  (add-to-queue {:runner 3 :running nil :next [{:e 1 :a 2}]} 2 {:e 3 :a 4})
  )

Record that the runner with id has finished running the animation. If there are more animations to run, move the next animation under the running key and remove it from :next. The same runner will continue running animations.

If there are no more animations to run, release the runner from duty by setting :runner to nil.

(defn- record-finished-animation
  [queue id]
  (if (empty? (:next queue))
    (assoc queue :runner nil :running nil)
    (assoc queue :running (first (:next queue)) :next (vec (rest (:next queue))))))
(comment

  (record-finished-animation {:runner 2, :running [{:e 1, :a 2}], :next []} 2)
  (record-finished-animation {:runner 3, :running nil, :next [{:e 1, :a 2} {:e 3, :a 4}]} 3)
  )
(declare play-animations)

This function is called when the runner with id has finished running an animation. After updating the queue, if this runner is still the designated runner, then start running the next animation. If the animation which has completed has an associated :after function, run it.

(defn- animation-finished
  [id {after :after}]
  (let [new-queue (swap! animation-queue record-finished-animation id)]
    (when after (after))
    (when (= (:runner new-queue) id)
      (play-animations id new-queue))))

Create the animation to run.

(defn- make-animation
  [{:keys [element animation]}]
  (cond element (bind element animation)
        (fn? animation) (animation)
        :else animation))

Called by a function which has been assigned the task of running animations until there are no more to run. id is the runner id. queue is the value of animation-queue after it was last updated. Runs any :before function then runs the animation. Arranges for animation-finished to be called when the animation is complete.

Implementation note: The delay is a hack to get around the fact that the finish event fires just before the animation has completed. The 100 ms delay gives the finished animation just enough time to complete before the next animation is started.

(defn- play-animations
  [id queue]
  (let [animation-map (:running queue)
        animation (make-animation animation-map)]
    (event/listen-once animation
                       "finish"
                       (fn [] (.start (goog.async.Delay. #(animation-finished id animation-map)) 100)))
    (when-let [before (:before animation-map)]
      (before))
    (start animation)))

Accepts an element and an animation and ensures that this animation will be run after all other animations that have been started by this function or by play-animation. An optional map may also be passed which may contain the keys :before and :after. Use the :before key to provide a function which will be called just before the animation starts. Use the :after key to provide a function which will be called after the aniamtion is finished.

The serial function allows you to create animations which run in sequence. The start function will run these animations. If start is called to run an animation before a previous call to start has completed, the animations can conflict. This function should be used instead of start when you need to ensure that animations do not overlap.

(defn play
  ([element animation]
     (play element animation {}))
  ([element animation {:keys [name after before]}]
     (let [id (swap! animation-id inc)
           animation {:name name :id id :element element :animation animation :before before :after after}
           queue (swap! animation-queue add-to-queue id animation)]
       (when (= (:runner queue) id)
         (play-animations id queue)))))

Accepts an animation and an optional map and ensures that this animation will be run after all other animations that have been started by this function or by play. See documentation for play.

(defn play-animation
  ([animation]
     (play-animation animation {}))
  ([animation opts]
     (play nil animation opts)))
 

one.browser.history

toc

Supports working with Google Closure's history management object.

(ns 
  one.browser.history
  (:require [clojure.browser.event :as event]
            [goog.History :as history]
            [goog.history.Html5History :as history5]))
(extend-type goog.History
  
  event/EventType
  (event-types [this]
    (into {}
          (map
           (fn [[k v]]
             [(keyword (. k (toLowerCase)))
              v])
           (js->clj goog.history.EventType)))))

Create a new history object in user visible mode. This allows users to, for example, hit the browser's back button without leaving the current page. The current history state is shown in the browser address bar as a document location fragment (the portion of the URL after the '#'). These addresses can be bookmarked, copied and pasted into another browser, and modified directly by the user like any other URL.

Any changes to the location hash will call the passed callback function.

(defn history
  [callback]
  (let [h (if (history5/isSupported)
            (goog.history.Html5History.)
            (goog.History.))]
    (do (event/listen h "navigate"
                      (fn [e]
                        (callback {:token (keyword (.-token e))
                                   :type (.-type e)
                                   :navigation? (.-isNavigation e)})))
        (.setEnabled h true)
        h)))

Sets the history state. The URL fragment will be set to the provided token.

(defn set-token
  [history token]
  (.setToken history (name token)))
 

one.browser.remote

toc

Make network requests.

(ns 
  one.browser.remote
  (:require [goog.net.XhrManager   :as manager]))
(def ^:private
  *xhr-manager*
  (goog.net.XhrManager. nil
                        nil
                        nil
                        0
                        5000))
(defn success?
  [{status :status}]
  (and (>= status 200)
       (<  status 300)))
(defn redirect?
  [{status :status}]
  (boolean (#{301 302 303 307} status)))
(defn error?
  [{status :status}]
  (>= status 400))
(defn- handle-response
  [on-success on-error e]
  (let [response {:id     (.-id e)
                  :body   (. e/currentTarget (getResponseText))
                  :status (. e/currentTarget (getStatus))
                  :event  e}
        handler  (if (success? response)
                   on-success
                   on-error)]
    (handler response)))

Asynchronously make a network request for the resource at url. If provided via the :on-success and :on-error keyword arguments, the appropriate one of on-success or on-error will be called on completion. They will be passed a map containing the keys :id, :body, :status, and :event. The entry for :event contains an instance of the goog.net.XhrManager.Event.

Other allowable keyword arguments are :method, :content, :headers, :priority, and :retries. :method defaults to "GET" and :retries defaults to 0.

(defn request
  [id url & {:keys [method content headers priority retries
                    on-success on-error]
             :or   {method   "GET"
                    retries  0}}]
  (try
    (.send *xhr-manager*
           id
           url
           method
           content
           (when headers (.-strobj headers))
           priority
           (partial handle-response on-success on-error)
           retries)
    (catch js/Error e
      nil)))
(defn url
  [path]
  (str (.-origin (.-location js/document)) path))
 

one.browser.repl-client

toc

Contains the repl function which may be used to start a repl client in the browser.

(ns 
  one.browser.repl-client
  (:require [goog.uri.utils :as uri]
            [clojure.browser.repl :as repl]))

Return a string which is the scheme and domain portion of the URL for the server from which this code was served.

(defn- server
  []
  (let [location (.toString window.location ())]
    (str (uri/getScheme location) "://" (uri/getDomain location))))

Connects to a ClojureScript REPL running on localhost port 9000.

This allows a browser-connected REPL to send JavaScript to the browser for evaluation. This function should be called from a script in the host HTML page.

(defn ^:export repl
  []
  (repl/connect (str (server) ":9000/repl")))
 

one.color

toc

Provide support for working with colors. Wraps Google Closure's color support. The goog.color namespace provides support for additional color formats.

(ns 
  one.color
  (:require [one.core :as core]
            [goog.string :as gstring]
            [goog.style :as style]
            [goog.color :as gcolor]
            [goog.color.alpha :as alpha]))
(defprotocol IColor
  (rgb [this] "Returns a vector `[r g b]`.")
  (rgba [this] "Returns a vector `[r g b a]`.")
  (hex [this] "Returns a hex string for this color.")
  (hex-rgba [this] "Returns a hex rgba string for this color.")
  (alpha [this] "Returns the alpha for this color, a number in the range `[0 1]`."))
(defrecord Color [r g b a]
  IColor
  (rgb [_] [r g b])
  (rgba [_] [r g b a])
  (hex [_]
    (gcolor/rgbArrayToHex (array r g b)))
  (hex-rgba [_]
    (alpha/rgbaArrayToHex (array r g b a)))
  (alpha [_] a))
(defn- make-color
  ([r g b]
     (make-color r g b 1))
  ([r g b a]
     (Color. r g b a)))
(comment ;; Color examples
  (def red (make-color 200 0 0))
  (rgb red)
  (rgba red)
  (hex red)
  (hex-rgba red)
  (alpha red))
(defprotocol IColorSource
  (color [this] "Get the color from the passed object. Return a `Color` object.")
  (bg-color [this] "Get the background color from the passed
  object. Returns a `Color` object."))
(extend-protocol IColorSource

  nil
  (color [this] (make-color 0 0 0))
  (bg-color [this] (make-color 0 0 0))

  Color
  (color [this] this)
  (bg-color [this] this)

  cljs.core.Vector
  (color [this] (apply make-color this))
  (bg-color [this] (apply make-color this))

  js/Array
  (color [this] (apply make-color (js->clj this)))
  (bg-color [this] (apply make-color (js->clj this)))

  js/String
  (color [this]
    (color (js->clj (cond (gstring/startsWith this "#")
                          (cond (= (count this) 7) (gcolor/hexToRgb this)
                                (= (count this) 9) (alpha/hexToRgba this))
                          
                          (gstring/startsWith this "rgba(")
                          (alpha/parse this)

                          (gstring/startsWith this "rgb(") (gcolor/parseRgb this))
                    :keywordize-keys true)))
  (bg-color [this] (color this))
  
  cljs.core.ObjMap
  (color [this] (color (:hex this)))
  (bg-color [this] (color this))
  
  js/Element
  (color [this]
    (color (js->clj (gcolor/parse (core/get-style this "color"))
                    :keywordize-keys true)))
  (bg-color [this]
    (color (js->clj (let [c (style/getBackgroundColor this)]
                      (try
                        (gcolor/parse c)
                        (catch js/Error e (alpha/parse c))))
                    :keywordize-keys true))))
 

one.core

toc

Core ClojureScript One library.

(ns 
  one.core
  (:require [goog.style :as style]))
(defprotocol Startable
  (start [this]))
(defprotocol Disposable
  (dispose [this]))

Use alternate strategies to get around the fact that goog.style.getComputedStyle returns an empty string for IE8 and below.

(defn get-style
  [element style]
  (some #(let [v (%)] (when (not= "" v) v))
        [#(style/getComputedStyle element style)
         #(style/getStyle element style)
         #(aget (.-currentStyle element) style)
         #(throw (js/Error. (str "Could not retrieve value for style " style)))]))
 

one.dispatch

toc

Event dispatching.

Provides a way for code to react to events. Terminology:

  • event-id: Identifies a class of events. Can be any Clojure value.

  • event-data: Parameterizes a particular event. Can be any Clojure value.

  • reactor: A function that is invoked in response to an event occurring.

  • reaction: A relationship between a set of events and a reactor.

  • event-pred: A function which takes an event ID and returns true or false.

    Reactors are associated with events via react-to. When events are fired with an event-id and optional event-data, any reactors whose event-pred returns true for the event-id are invoked.

(ns 
  one.dispatch)

Stores the current reactions.

(def 
  reactions (atom {}))

Cause the specified reactor to be invoked whenever an event that satisfies event-pred is fired. reactor is a function that accepts two arguments: event-id and event-data.

Returns the reaction.

The reactor will continue to be invoked until one of two things happens:

  1. delete-reaction is called on this reaction.

  2. The reaction occurs max-count times. If max-count is not specified, the reaction will continue to be invoked until deleted.

    If max-count is specified, delete-reaction will be called automatically when the reaction has occurred the specified number of times.

(defn react-to
  ([event-pred reactor]
     (react-to nil event-pred reactor))
  ([max-count event-pred reactor]
     (let [reaction {:max-count max-count
                     :event-pred event-pred
                     :reactor reactor}]
       (swap! reactions assoc reaction 0)
       reaction)))

Delete a reaction. After calling this function, the specified reaction will no longer be invoked.

(defn delete-reaction
  [reaction]
  (swap! reactions dissoc reaction))

Raise an event to any reactors whose event-pred returns true for event-id. The event-id and event-data, if specified, are passed to the reactor.

(defn fire
  ([event-id]
     (fire event-id nil))
  ([event-id event-data]
     (let [matching-reactions (filter (fn [[{event-pred :event-pred} run-count]]
                                        (event-pred event-id))
                                      @reactions)]
       (doseq [[reaction run-count] matching-reactions]
         (let [{:keys [max-count reactor]} reaction
               run-count (inc run-count)]
           (reactor event-id event-data)
           (if (and max-count
                    (<= max-count run-count))
             (delete-reaction reaction)
             (swap! reactions assoc reaction run-count)))))))
 

one.logging

toc

Basic wrapper around Google Closure's logging API.

This library can be improved to support more of the features provided by Google Closure's logging.

(ns 
  one.logging
  (:require [goog.debug.Console :as console]
            [goog.debug.FancyWindow :as fancy]
            [goog.debug.Logger :as logger]))
(defprotocol ILogViewer
  (start-display [this] "Start displaying log messages in this viewer.")
  (stop-display [this] "Stop displaying log messages in this viewer."))

Maps log level keywords to goog.debug.Logger.Levels.

(def 
  levels {:severe goog.debug.Logger.Level.SEVERE
          :warning goog.debug.Logger.Level.WARNING
          :info goog.debug.Logger.Level.INFO
          :config goog.debug.Logger.Level.CONFIG
          :fine goog.debug.Logger.Level.FINE
          :finer goog.debug.Logger.Level.FINER
          :finest goog.debug.Logger.Level.FINEST})

Given a name, return an existing logger if one exists or create a new logger.

(defn get-logger
  [name]
  (goog.debug.Logger/getLogger name))

Given a logger and a message, write the message to the log with a logging level of severe.

(defn severe
  [logger s] (.severe logger s))

Given a logger and a message, write the message to the log with a logging level of warning.

(defn warning
  [logger s] (.warning logger s))

Given a logger and a message, write the message to the log with a logging level of info.

(defn info
  [logger s] (.info logger s))

Given a logger and a message, write the message to the log with a logging level of config.

(defn config
  [logger s] (.config logger s))

Given a logger and a message, write the message to the log with a logging level of fine.

(defn fine
  [logger s] (.fine logger s))

Given a logger and a message, write the message to the log with a logging level of finer.

(defn finer
  [logger s] (.finer logger s))

Given a logger and a message, write the message to the log with a logging level of finest.

(defn finest
  [logger s] (.finest logger s))

Set the logging level of logger to level.

The level argument must be a keyword.

(defn set-level
  [logger level]
  (.setLevel logger (get levels level goog.debug.Logger.Level.INFO)))
(extend-protocol ILogViewer
  
  goog.debug.Console
  (start-display [this]
    (.setCapturing this true))
  (stop-display [this]
    (.setCapturing this false))
  
  goog.debug.FancyWindow
  (start-display [this]
    (doto this
      (.setEnabled true)
      (.init ())))
  (stop-display [this]
    (.setCapturing this false)))

Returns a log viewer which will direct log messages to the browser's console window. Use the start-display and stop-display functions to start and stop printing log messages to the console.

(defn console-output
  []
  (goog.debug.Console.))

Returns a log viewer which will open a fancy logging window and direct log messages to it. Use the start-display and stop-display functions to start and stop printing log messages in this window.

(defn fancy-output
  [name]
  (goog.debug.FancyWindow. name))