Mercurial > lasercutter

     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)))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children