Commits

Anonymous committed 8d38d48

Renamed cx to context in neman.xml and added context destructuring in templates.

  • Participants
  • Parent commits c4cf76d

Comments (0)

Files changed (7)

File examples/xml2.clj

 ;; remove this notice, or any other, from this software.
 
 (ns user
-  (:use net.ksojat.neman.core [net.ksojat.neman.xml :only [render template template-from cx child]])
+  (:use net.ksojat.neman.core [net.ksojat.neman.xml :only [render template template-from child]])
   (:import (org.jdom.output XMLOutputter)))
 
 (def base
-  (template
+  (template [title message]
     (=> :html
       [(=> :head
-         [(=> :title [(cx :title)])])
+         [(=> :title [title])])
        (=> :body
-         [(=> :h1 [(cx :title)])
+         [(=> :h1 [title])
           (child :body)
-          (=> :p [(cx :message)])
+          (=> :p [message])
           (child :extra)])])))
 
 (def level1

File examples/xml3.clj

+(ns user
+  (:use
+    (net.ksojat.neman
+      core
+      [web :only [url-for url-for-path *current-path*]]
+      [xml :only [render xml xml-node xml-nodes template template-from child]])))
+
+
+;(def baseh
+;  (template
+;    (=> :html
+;      [(=>> (:head [(child :head) (child :css)])
+;            (:body [(child :body) (child :js)]))])))
+
+(def baseh
+  (template
+    (=> :html
+      [(=> :head [(child :head) (child :css)])
+       (=> :body [(child :body) (child :js)])])))
+
+
+(def base
+  (template-from baseh
+    (:head
+      (=> :meta {:http-equiv "Content-Type" :content "text/html; charset=utf-8"})
+      (=> :title "Hatchery Alpha")
+      ;(shortcut-icon "media/favicon.png")
+      (child :head))
+    (:css
+      (child :css))
+    (:js
+      (child :js))
+    (:body
+      (=> :div {:id "main"}
+        [(=> :div {:id "header" :class "fluid"}
+           [(=> :h1 "Hatchery")
+            (=> :p "Experiments in Genetic Algorithms, Procedural Graphics and Functional Languages")])
+         (child :body)])
+
+      (=> :div {:id "footer"}
+        "© 2008.  Kre\u0161imir \u0160ojat. All right reserved."))))
+
+;(def base2
+;  (template-from base
+;    (:body
+;      (=> :div.fluid#nav
+;        [(=> :form.search
+;           [(=>> (:label {:for "search"} "Search")
+;                 (:input.search {:type "text" :name "search"})
+;                 (:input {:type "submit" :value "Go"}))])
+;         (=> :div {:class "clear"})])
+;      (=> :div [(child :body)]))))
+
+;(def index-template
+;  (template-from baseh
+;    (:body
+;      (=> :a))))
+
+(render base)

File src/net/ksojat/neman/core.clj

     (doseq [i (range c)] (aset a i (nth s i)))
     a))
 
+;; 'flatten' written by Rich Hickey,
+;; see http://groups.google.com/group/clojure/msg/385098fabfcaad9b
+(defn flatten
+  "Takes any nested combination of sequential things (lists, vectors,
+  etc.) and returns their contents as a single, flat sequence.
+  (flatten nil) returns nil."
+  [x]
+  (filter (complement sequential?)
+          (rest (tree-seq sequential? seq x))))
+
 (defn- make-args [x]
   (if x (to-array x) RT/EMPTY_ARRAY))
 
             (reverse p)))
       ~gx)))
 
-(defmacro with-builder-vars
+(defmacro let-builder-ids
   ([x]
-    `(with-builder-vars {:id :Id :result :toplevel} ~x))
+    `(let-builder-vars {:id :Id :result :toplevel} ~x))
 
   ([{id :id result :result} x]
     `(do ~x)))
-

File src/net/ksojat/neman/storage.clj

+;; Copyright (c) 2008 Krešimir Šojat. All rights reserved.  The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
+;; which can be found in the file CPL.TXT at the root of this
+;; distribution.  By using this software in any fashion, you are
+;; agreeing to be bound by the terms of this license.  You must not
+;; remove this notice, or any other, from this software.
+
+(ns net.ksojat.neman.storage)

File src/net/ksojat/neman/web.clj

 (defmethod guard :delete [_ request]
   (guard :method request #{:delete}))
 
-;(defmethod guard :header [_ request header-map]
-;  (every? #(not= nil %)
-;    (map
-;      (fn [[k v]]
-;        (let [h (.getHeader request k)]
-;          (if (ifn? v) (v h) (when (= v h) h))))
-;      header-map)))
-
 (defmethod guard :header [_ request header-map]
-  (every? #(not= nil %)
+  (every? true?
     (map
       (fn [[k v]]
         (let [h (.getHeader request k)]
             :else      (= v h))))
       header-map)))
 
-
 (defmethod guard :xhr [_ request]
   (guard :header request {"X-Requested-With" "XMLHttpRequest"}))
 
 ;  (.getRemoteUser request))
 
 (defmacro match [& clauses]
-  (let [clauses (apply concat
-                  (map
-                    (fn [[test expr]]
-                      (if (seq? test)
-                        [`(and ~@(map (fn [t] `(guard ~t *request*)) test)) expr]
-                        [`(guard ~test *request*) expr]))
-                    (partition 2 clauses)))]
+  (let [make-guard (fn [test]
+                     (let [[f & r] (if (vector? test) test (vector test))]
+                       `(guard ~f *request* ~@r)))
+        clauses (mapcat
+                  (fn [[test expr]]
+                    [(if (seq? test)
+                       `(and ~@(map (fn [t] (make-guard t)) test)) (make-guard test))
+                     expr])
+                  (partition 2 clauses))]
     `(cond ~@clauses)))
 
 ;;

File src/net/ksojat/neman/xml.clj

 (defmethod patch [Element 'setAttributes] [o _ a]
   (if (map? a)
     (doseq [[k v] a]
-      (if v (.setAttribute o (name k) v)))
-    (.setAttributes o a)))
+      (if v (.setAttribute o (name k) (str v))))
+    (.setAttributes o (str a))))
+
+(defn element? [x]
+  (instance? Element x))
 
 (defmethod patch [Element 'addContent] [o _ a]
-  (if (seq? a)
-    (doseq [x a] (.addContent o x))
-    (.addContent o a)))
+  (cond
+    (seq? a) (doseq [x a] (.addContent o x))
+    ;(seq? a)     (doseq [x a]
+    ;               (.addContent o (if (element? x) x (str x))))
+    (element? a) (.addContent o a)
+    :else        (.addContent o (str a))))
+
+(def tag-re #"([^.#]+)(?:(?:\.)([^#]*))?(?:(?:#)([^.]*))?")
+
+(defn xml-keyword-ctor [x]
+  (let [[_ tag classes id] (re-matches tag-re (name x))]
+    (=> (Element. tag)
+      {:class (when classes (.replace classes "." " "))
+       :id    id})))
 
 (defn xml-ctor [x]
   ; Fix for strage behaviour with JDOM 1.1 when adding node with no content.
   (.addContent
-    (if (keyword? x) (Element. (name x)) x) ""))
+    (if (keyword? x) (xml-keyword-ctor x) x) ""))
 
 (defmacro xml-node [node]
   `(binding [*ctor* #'xml-ctor] ~node))
 (defmacro xml-nodes [& nodes]
   `(binding [*ctor* #'xml-ctor] (list ~@nodes)))
 
+;(defmacro xml-nodes [& nodes]
+;  `(binding [*ctor* #'xml-ctor] (flatten ~nodes)))
+
 (defmacro xml
   ([root-node]
     (let [doc (gensym)]
 ;; Templates.
 ;;
 
-(declare cx child)
+(declare context child)
 
-(defmacro template [& body]
+(defn context-bindings [bindings]
+  (let [as-kw  #(keyword (name %))
+        expand (fn ([a1]       [a1 `(context ~(as-kw a1))])
+                   ([a1 a2]    (if (symbol? a1)
+                                 [a1 `(context ~(as-kw a1) (str ~a2))]
+                                 [a1 `(context ~(as-kw a2))]))
+                   ([a1 a2 a3] [a1 `(context ~(as-kw a2) (str ~a3))]))]
+    (vec (mapcat
+           (fn [v]
+            (if (vector? v) (apply expand v) (apply expand v '())))
+            bindings))))
+
+(defmacro template* [& body]
   `(fn [context# children#]
-     (binding [cx (fn [x#] (context# x#)), child (fn [y#] (children# y#))]
+     (binding [context context#, child children#]
        (xml ~@body))))
 
-(defmacro template-from [base & children]
+(defmacro template [& [f & r :as body]]
+  (if (vector? f)
+    `(template* (let ~(context-bindings f) ~@r)) `(template* ~@body)))
+
+(defmacro template-from* [base & children]
   (let [local-children (into {}
-                         (map
-                           #(vector (first %) `(xml-nodes ~@(rest %)))
-                           children))]
+                         (map (fn [[f & r]] [f `(xml-nodes ~@r)]) children))]
     `(fn [context# children#]
-       (binding [cx (fn [x#] (context# x#)), child (fn [y#] (children# y#))]
-         (let [local-children# ~local-children]
-           (~base context# (merge children# local-children#)))))))
+       (binding [context context#, child children#]
+         (~base context# (merge children# ~local-children))))))
+
+(defn child-block [[name & [f & r :as body] :as block]]
+  (if (vector? f)
+    `(~name (let ~(context-bindings f) ~@r)) `(~@block)))
+
+(defmacro template-from [base & [f & r :as body]]
+  (let [base (if (keyword? base) `(context ~base) base)]
+    (if (vector? f)
+      (let [c (context-bindings f)]
+        `(template-from* ~base ~@(map (fn [[n & ns]] `(~n (let ~c ~@ns))) (map child-block r))))
+      `(template-from* ~base ~@(map child-block body)))))
 
 (defn expand [template context]
   (template context {}))

File tests/JDOMTest.java

+
+import java.io.FileWriter;
+import org.jdom.Document;
+import org.jdom.Element;
+import org.jdom.output.XMLOutputter;
+
+public class JDOMTest {
+
+    public static void main(String[] args) {
+        Document doc = new Document();
+
+        Element html = new Element("html");
+        doc.setRootElement(html);
+
+        Element body = new Element("body");
+        html.addContent(body);
+
+        Element div1 = new Element("div");
+        body.addContent(div1);
+
+        Element ul = new Element("ul");
+        div1.addContent(ul);
+
+        Element li = new Element("li");
+        ul.addContent(li);
+
+        Element a = new Element("a");
+        li.addContent(a);
+        a.addContent("xxxxxx");
+
+        Element div2 = new Element("div");
+        div1.addContent(div2);
+        /*div2.addContent("zzzzz");*/
+
+        Element div3 = new Element ("div");
+        body.addContent(div3);
+        div3.addContent("qqqq");
+
+        try {
+            FileWriter w = new FileWriter("jout.html");
+            (new XMLOutputter()).output(doc, w);
+            w.close();
+        } catch(Exception e) {}
+    }
+}
+