Anonymous avatar Anonymous committed b3ef461

New builder code for swing and initial code for automatic rules creation from paths in neman.web.

Comments (0)

Files changed (4)

             <arg value='net.ksojat.neman.textile'/>
             <arg value='net.ksojat.neman.css'/>
             <arg value='net.ksojat.neman.cells'/>
+	    <arg value='net.ksojat.neman.swing'/>
         </java>
 
         <jar destfile='${build.jar}'>

src/net/ksojat/neman/cells.clj

 (defmacro cell [parents bindings expr]
   `(alter-cell (net.ksojat.neman.cells.Cell. {}) ~parents ~bindings ~expr))
 
+;(defn add-trigger [cell trigger-fn]
+;  (dosync
+;    (alter (.state cell) update-in [:triggers] conj trigger-fn))
+;  trigger-fn)
+
 (defn add-trigger [cell trigger-fn]
   (dosync
-    (alter (.state cell) update-in [:triggers] conj trigger-fn))
+    (alter (.state cell) assoc-in :triggers conj trigger-fn))
   trigger-fn)
 
+;(defn remove-trigger [cell trigger-fn]
+;  
+
+;; TODO: add special :this parent, so cells can be accumulators
+
 (comment
   (def a (ref 1))
   (def b (ref 2))

src/net/ksojat/neman/swing.clj

 ;; remove this notice, or any other, from this software.
 
 (ns net.ksojat.neman.swing
+  (:import
+    (clojure.lang Reflector RT))
   (:use net.ksojat.neman.core))
 
 (defn swing-invoke [f]
-  nil)
+  (javax.swing.SwingUtilities/invokeLater f))
 
 (defmacro layout-data [expr]
   ~expr)
 
 (defmacro swing [expr]
   `(layout-data (let-builder-ids ~expr)))
+
+;;
+;; Event listeners.
+;;
+
+(defmulti on (fn [widget action callback] action))
+
+(defmethod on :action-performed [widget action callback]
+  (.addActionListener widget
+    (proxy [java.awt.event.ActionListener] []
+      (actionPerformed [#^java.awt.event.ActionEvent e]
+        (callback e)))))
+
+;;
+;; Builder integration.
+;;
+
+(defmethod default-method [javax.swing.JFrame    :vector] [& _] 'add)
+(defmethod default-method [javax.swing.JMenuBar  :vector] [& _] 'add)
+(defmethod default-method [javax.swing.JMenu     :vector] [& _] 'add)
+(defmethod default-method [javax.swing.JMenuItem :vector] [& _] 'add)
+(defmethod default-method [javax.swing.JToolBar  :vector] [& _] 'add)
+
+;(default-method
+;  [javax.swing.JFrame    :vector 'add]
+;  [javax.swing.JMenuBar  :vector 'add]
+;  [javax.swing.JMenuItem :vector 'add]
+;  [javax.swing.JToolBar  :vector 'add])
+
+(defmethod patch [javax.swing.JRadioButtonMenuItem 'setGroup] [o _ g]
+  (.add g o))
+
+(defn extract-mnemonic [s]
+  (let [m     (re-matcher #"&(\w)" s)
+        [_ c] (re-find m)]
+    (if c
+      [(.start m) (.replaceFirst m c) (first c)]
+      [-1 s nil])))
+
+(defn set-abutton [x label-text]
+  (let [[_ raw-text accelerator] (or
+                                   (re-find #"^(.*)(?:\s+)(?:\[(.*)\])$" label-text)
+                                   [nil label-text nil])
+        [index text mnemonic] (extract-mnemonic raw-text)]
+    (.setText x text)
+    (when accelerator
+      (.setAccelerator x (javax.swing.KeyStroke/getKeyStroke accelerator)))
+    (when mnemonic
+      (doto x
+        (.setMnemonic mnemonic)
+        (.setDisplayedMnemonicIndex index)))
+    x))
+
+(defmethod ctor javax.swing.AbstractButton [c s]
+  (let [o (Reflector/invokeConstructor c RT/EMPTY_ARRAY)]
+    (set-abutton o s)))

src/net/ksojat/neman/web.clj

 (defmethod update-response IPersistentMap [response x]
   (doseq [k (keys x)] (.setHeader response k (x k))))
 
+; TODO: Inject status in Response, replace this and the one in mapper
 (defmethod update-response Keyword [response x]
   (.setStatus response (status x)))
 
           (update-response *response* res))))
     (when (seq rs) (recur url-path rs))))
 
+;; TODO: Move to core
+;(defn tree-paths [tree]
+;  (let [paths (fn paths [parent children]
+;                (mapcat
+;                  (fn [[k v]]
+;                    (let [p (conj parent k)]
+;                      (if (map? v) (paths p v) [p v])))
+;                  children))]
+;    (paths [] tree)))
+
+;(defn tree-paths [tree]
+;  (let [paths (fn paths [parent children]
+;                (mapcat
+;                  (fn [[k v]]
+;                    (let [p (conj parent k)]
+;                      (if (branch? v) (paths p v) [p v])))
+;                  children))]
+;    (paths [] tree)))
+
+(defn tree-paths [branch? tree]
+  (let [paths (fn paths [parent children]
+                (mapcat
+                  (fn [[k v]]
+                    (let [p (conj parent k)]
+                      (if (branch? v) (paths p v) [p v])))
+                  children))]
+    (paths [] tree)))
+
+(defn auto-rules [paths rule-ex]
+  (let [paths           (tree-paths (complement view?) paths)
+        [rel-ex abs-ex] (split-with (fn [[k _]] (keyword? k)) rule-ex)]
+    (println paths)))
+
 (defn mapper [paths rules]
   (let [routes (cell [paths rules] [p r] (create-routes p r))]
     (jetty/handler
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.