rlm@10: ;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
rlm@10: ;;  distribution terms for this software are covered by the Eclipse Public
rlm@10: ;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
rlm@10: ;;  be found in the file epl-v10.html at the root of this distribution.  By
rlm@10: ;;  using this software in any fashion, you are agreeing to be bound by the
rlm@10: ;;  terms of this license.  You must not remove this notice, or any other,
rlm@10: ;;  from this software.
rlm@10: ;;
rlm@10: ;;  clojure.contrib.miglayout.internal
rlm@10: ;;
rlm@10: ;;  Internal functions for 'clojure.contrib.miglayout
rlm@10: ;;
rlm@10: ;;  scgilardi (gmail)
rlm@10: ;;  Created 13 October 2008
rlm@10: 
rlm@10: (ns clojure.contrib.miglayout.internal
rlm@10:   (:import (clojure.lang RT Reflector)
rlm@10:            java.awt.Component
rlm@10:            javax.swing.JComponent)
rlm@10:   (:use (clojure.contrib
rlm@10:          [core :only (new-by-name)]
rlm@10:          [except :only (throwf)]
rlm@10:          [fcase :only (fcase)]
rlm@10:          [string :only (as-str)])))
rlm@10: 
rlm@10: (def MigLayout "net.miginfocom.swing.MigLayout")
rlm@10: (def LayoutCallback "net.miginfocom.layout.LayoutCallback")
rlm@10: (def ConstraintParser "net.miginfocom.layout.ConstraintParser")
rlm@10: 
rlm@10: (declare format-constraints)
rlm@10: 
rlm@10: (defn format-constraint
rlm@10:   "Returns a vector of vectors representing one or more constraints
rlm@10:   separated by commas. Constraints may be specified in Clojure using
rlm@10:   strings, keywords, vectors, maps, and/or sets."
rlm@10:   [c]
rlm@10:   [[", "]
rlm@10:    (fcase #(%1 %2) c
rlm@10:      string?  [c]
rlm@10:      keyword? [c]
rlm@10:      vector?  (interpose " " c)
rlm@10:      map?     (apply concat (interpose [", "] (map #(interpose " " %) c)))
rlm@10:      set?     (apply concat (interpose [", "] (map format-constraints c)))
rlm@10:      (throwf IllegalArgumentException
rlm@10:              "unrecognized constraint: %s (%s)" c (class c)))])
rlm@10: 
rlm@10: (defn format-constraints
rlm@10:   "Returns a string representing all the constraints for one keyword-item
rlm@10:   or component formatted for miglayout."
rlm@10:   [& constraints]
rlm@10:   (let [formatted
rlm@10:         (apply str
rlm@10:           (map as-str
rlm@10:             (rest (reduce concat []
rlm@10:               (mapcat format-constraint constraints)))))]
rlm@10: ;;  (prn formatted)
rlm@10:     formatted))
rlm@10: 
rlm@10: (defn component?
rlm@10:   "Returns true if x is a java.awt.Component"
rlm@10:   [x]
rlm@10:   (instance? Component x))
rlm@10: 
rlm@10: (defn constraint?
rlm@10:   "Returns true if x is not a keyword-item or component"
rlm@10:   [x]
rlm@10:   (not
rlm@10:    (or (component? x)
rlm@10:        (#{:layout :column :row} x))))
rlm@10: 
rlm@10: (defn parse-item-constraints
rlm@10:   "Iterates over args and builds a map containing values associated with
rlm@10:   :keywords and :components. The value for :keywords is a map from keyword
rlm@10:   items to constraints strings. The value for :components is a vector of
rlm@10:   vectors each associating a component with its constraints string."
rlm@10:   [& args]
rlm@10:   (loop [[item & args] args
rlm@10:          item-constraints {:keywords {} :components []}]
rlm@10:     (if item
rlm@10:       (let [[constraints args] (split-with constraint? args)]
rlm@10:         (recur args
rlm@10:           (update-in
rlm@10:            item-constraints
rlm@10:            [(if (component? item) :components :keywords)]
rlm@10:            conj [item (apply format-constraints constraints)])))
rlm@10:       item-constraints)))
rlm@10: 
rlm@10: (defn parse-component-constraint
rlm@10:   "Parses a component constraint string returning a CC object"
rlm@10:   [constraint]
rlm@10:   (Reflector/invokeStaticMethod
rlm@10:    ConstraintParser "parseComponentConstraint" (into-array [constraint])))
rlm@10: 
rlm@10: (defn add-components
rlm@10:   "Adds components with constraints to a container"
rlm@10:   [^JComponent container components]
rlm@10:   (loop [[[^Component component constraint] & components] components
rlm@10:          id-map nil]
rlm@10:     (if component
rlm@10:       (let [cc (parse-component-constraint constraint)]
rlm@10:         (.add container component cc)
rlm@10:         (recur
rlm@10:          components
rlm@10:          (if-let [id (.getId cc)]
rlm@10:            (assoc id-map (keyword id) component)
rlm@10:            id-map)))
rlm@10:       (doto container (.putClientProperty ::components id-map)))))
rlm@10: 
rlm@10: (defn get-components
rlm@10:   "Returns a map from id to component for all components with an id"
rlm@10:   [^JComponent container]
rlm@10:   (.getClientProperty container ::components))
rlm@10: 
rlm@10: (defn do-layout
rlm@10:   "Attaches a MigLayout layout manager to container and adds components
rlm@10:   with constraints"
rlm@10:   [^JComponent container layout column row components]
rlm@10:   (doto container
rlm@10:     (.setLayout (new-by-name MigLayout layout column row))
rlm@10:     (add-components components)))