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