Mercurial > lasercutter

comparison src/clojure/contrib/miglayout/internal.clj @ 10:ef7dbbd6452c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
comparison
equal deleted inserted replaced
9:35cf337adfcf 10:ef7dbbd6452c
1 ;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
2 ;; distribution terms for this software are covered by the Eclipse Public
3 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
4 ;; be found in the file epl-v10.html at the root of this distribution. By
5 ;; using this software in any fashion, you are agreeing to be bound by the
6 ;; terms of this license. You must not remove this notice, or any other,
7 ;; from this software.
8 ;;
9 ;; clojure.contrib.miglayout.internal
10 ;;
11 ;; Internal functions for 'clojure.contrib.miglayout
12 ;;
13 ;; scgilardi (gmail)
14 ;; Created 13 October 2008
15
16 (ns clojure.contrib.miglayout.internal
17 (:import (clojure.lang RT Reflector)
18 java.awt.Component
19 javax.swing.JComponent)
20 (:use (clojure.contrib
21 [core :only (new-by-name)]
22 [except :only (throwf)]
23 [fcase :only (fcase)]
24 [string :only (as-str)])))
25
26 (def MigLayout "net.miginfocom.swing.MigLayout")
27 (def LayoutCallback "net.miginfocom.layout.LayoutCallback")
28 (def ConstraintParser "net.miginfocom.layout.ConstraintParser")
29
30 (declare format-constraints)
31
32 (defn format-constraint
33 "Returns a vector of vectors representing one or more constraints
34 separated by commas. Constraints may be specified in Clojure using
35 strings, keywords, vectors, maps, and/or sets."
36 [c]
37 [[", "]
38 (fcase #(%1 %2) c
39 string? [c]
40 keyword? [c]
41 vector? (interpose " " c)
42 map? (apply concat (interpose [", "] (map #(interpose " " %) c)))
43 set? (apply concat (interpose [", "] (map format-constraints c)))
44 (throwf IllegalArgumentException
45 "unrecognized constraint: %s (%s)" c (class c)))])
46
47 (defn format-constraints
48 "Returns a string representing all the constraints for one keyword-item
49 or component formatted for miglayout."
50 [& constraints]
51 (let [formatted
52 (apply str
53 (map as-str
54 (rest (reduce concat []
55 (mapcat format-constraint constraints)))))]
56 ;; (prn formatted)
57 formatted))
58
59 (defn component?
60 "Returns true if x is a java.awt.Component"
61 [x]
62 (instance? Component x))
63
64 (defn constraint?
65 "Returns true if x is not a keyword-item or component"
66 [x]
67 (not
68 (or (component? x)
69 (#{:layout :column :row} x))))
70
71 (defn parse-item-constraints
72 "Iterates over args and builds a map containing values associated with
73 :keywords and :components. The value for :keywords is a map from keyword
74 items to constraints strings. The value for :components is a vector of
75 vectors each associating a component with its constraints string."
76 [& args]
77 (loop [[item & args] args
78 item-constraints {:keywords {} :components []}]
79 (if item
80 (let [[constraints args] (split-with constraint? args)]
81 (recur args
82 (update-in
83 item-constraints
84 [(if (component? item) :components :keywords)]
85 conj [item (apply format-constraints constraints)])))
86 item-constraints)))
87
88 (defn parse-component-constraint
89 "Parses a component constraint string returning a CC object"
90 [constraint]
91 (Reflector/invokeStaticMethod
92 ConstraintParser "parseComponentConstraint" (into-array [constraint])))
93
94 (defn add-components
95 "Adds components with constraints to a container"
96 [^JComponent container components]
97 (loop [[[^Component component constraint] & components] components
98 id-map nil]
99 (if component
100 (let [cc (parse-component-constraint constraint)]
101 (.add container component cc)
102 (recur
103 components
104 (if-let [id (.getId cc)]
105 (assoc id-map (keyword id) component)
106 id-map)))
107 (doto container (.putClientProperty ::components id-map)))))
108
109 (defn get-components
110 "Returns a map from id to component for all components with an id"
111 [^JComponent container]
112 (.getClientProperty container ::components))
113
114 (defn do-layout
115 "Attaches a MigLayout layout manager to container and adds components
116 with constraints"
117 [^JComponent container layout column row components]
118 (doto container
119 (.setLayout (new-by-name MigLayout layout column row))
120 (add-components components)))