1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/miglayout/internal.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,120 @@
     1.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
     1.5 +;;  distribution terms for this software are covered by the Eclipse Public
     1.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
     1.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
     1.8 +;;  using this software in any fashion, you are agreeing to be bound by the
     1.9 +;;  terms of this license.  You must not remove this notice, or any other,
    1.10 +;;  from this software.
    1.11 +;;
    1.12 +;;  clojure.contrib.miglayout.internal
    1.13 +;;
    1.14 +;;  Internal functions for 'clojure.contrib.miglayout
    1.15 +;;
    1.16 +;;  scgilardi (gmail)
    1.17 +;;  Created 13 October 2008
    1.18 +
    1.19 +(ns clojure.contrib.miglayout.internal
    1.20 +  (:import (clojure.lang RT Reflector)
    1.21 +           java.awt.Component
    1.22 +           javax.swing.JComponent)
    1.23 +  (:use (clojure.contrib
    1.24 +         [core :only (new-by-name)]
    1.25 +         [except :only (throwf)]
    1.26 +         [fcase :only (fcase)]
    1.27 +         [string :only (as-str)])))
    1.28 +
    1.29 +(def MigLayout "net.miginfocom.swing.MigLayout")
    1.30 +(def LayoutCallback "net.miginfocom.layout.LayoutCallback")
    1.31 +(def ConstraintParser "net.miginfocom.layout.ConstraintParser")
    1.32 +
    1.33 +(declare format-constraints)
    1.34 +
    1.35 +(defn format-constraint
    1.36 +  "Returns a vector of vectors representing one or more constraints
    1.37 +  separated by commas. Constraints may be specified in Clojure using
    1.38 +  strings, keywords, vectors, maps, and/or sets."
    1.39 +  [c]
    1.40 +  [[", "]
    1.41 +   (fcase #(%1 %2) c
    1.42 +     string?  [c]
    1.43 +     keyword? [c]
    1.44 +     vector?  (interpose " " c)
    1.45 +     map?     (apply concat (interpose [", "] (map #(interpose " " %) c)))
    1.46 +     set?     (apply concat (interpose [", "] (map format-constraints c)))
    1.47 +     (throwf IllegalArgumentException
    1.48 +             "unrecognized constraint: %s (%s)" c (class c)))])
    1.49 +
    1.50 +(defn format-constraints
    1.51 +  "Returns a string representing all the constraints for one keyword-item
    1.52 +  or component formatted for miglayout."
    1.53 +  [& constraints]
    1.54 +  (let [formatted
    1.55 +        (apply str
    1.56 +          (map as-str
    1.57 +            (rest (reduce concat []
    1.58 +              (mapcat format-constraint constraints)))))]
    1.59 +;;  (prn formatted)
    1.60 +    formatted))
    1.61 +
    1.62 +(defn component?
    1.63 +  "Returns true if x is a java.awt.Component"
    1.64 +  [x]
    1.65 +  (instance? Component x))
    1.66 +
    1.67 +(defn constraint?
    1.68 +  "Returns true if x is not a keyword-item or component"
    1.69 +  [x]
    1.70 +  (not
    1.71 +   (or (component? x)
    1.72 +       (#{:layout :column :row} x))))
    1.73 +
    1.74 +(defn parse-item-constraints
    1.75 +  "Iterates over args and builds a map containing values associated with
    1.76 +  :keywords and :components. The value for :keywords is a map from keyword
    1.77 +  items to constraints strings. The value for :components is a vector of
    1.78 +  vectors each associating a component with its constraints string."
    1.79 +  [& args]
    1.80 +  (loop [[item & args] args
    1.81 +         item-constraints {:keywords {} :components []}]
    1.82 +    (if item
    1.83 +      (let [[constraints args] (split-with constraint? args)]
    1.84 +        (recur args
    1.85 +          (update-in
    1.86 +           item-constraints
    1.87 +           [(if (component? item) :components :keywords)]
    1.88 +           conj [item (apply format-constraints constraints)])))
    1.89 +      item-constraints)))
    1.90 +
    1.91 +(defn parse-component-constraint
    1.92 +  "Parses a component constraint string returning a CC object"
    1.93 +  [constraint]
    1.94 +  (Reflector/invokeStaticMethod
    1.95 +   ConstraintParser "parseComponentConstraint" (into-array [constraint])))
    1.96 +
    1.97 +(defn add-components
    1.98 +  "Adds components with constraints to a container"
    1.99 +  [^JComponent container components]
   1.100 +  (loop [[[^Component component constraint] & components] components
   1.101 +         id-map nil]
   1.102 +    (if component
   1.103 +      (let [cc (parse-component-constraint constraint)]
   1.104 +        (.add container component cc)
   1.105 +        (recur
   1.106 +         components
   1.107 +         (if-let [id (.getId cc)]
   1.108 +           (assoc id-map (keyword id) component)
   1.109 +           id-map)))
   1.110 +      (doto container (.putClientProperty ::components id-map)))))
   1.111 +
   1.112 +(defn get-components
   1.113 +  "Returns a map from id to component for all components with an id"
   1.114 +  [^JComponent container]
   1.115 +  (.getClientProperty container ::components))
   1.116 +
   1.117 +(defn do-layout
   1.118 +  "Attaches a MigLayout layout manager to container and adds components
   1.119 +  with constraints"
   1.120 +  [^JComponent container layout column row components]
   1.121 +  (doto container
   1.122 +    (.setLayout (new-by-name MigLayout layout column row))
   1.123 +    (add-components components)))