Clojure GridBag宏和print-dup
|
我正在编写一个Clojure宏，它使用
java.awt.GridBagLayout
(doto ...)
(Insets. 5 5 5 5)
(eval ...)
#=(...)
(defn ...)
(print-dup...)
(grid-bag-container (JPanel. (GridBagLayout.))
[(JButton \"Monday\") :gridwidth 2 :weightx 1.0 :fill :HORIZONTAL]
[(JCheckBox \"Vacation\")]
[[(JLabel. \"Arrive:\")] [(JTextField. 6) :fill :HORIZONTAL]]
[[(JLabel. \"Depart:\")] [(JTextField. 6) :fill :HORIZONTAL]])
(doto (JPanel. (GridBagLayout.))
(.add (JButton \"Monday\")
(GridBagConstraints. 0 0 2 1 1.0 0
(. GridBagConstraints WEST)
(. GridBagConstraints HORIZONTAL)
(Insets. 2 2 2 2) 0 0))
(.add (JCheckBox \"Vacation\")
(GridBagConstraints. 0 1 1 1 0 0
(. GridBagConstraints WEST)
(. GridBagConstraints NONE)
(Insets. 2 2 2 2) 0 0))
(.add (JLabel. \"Arrive:\")
(GridBagConstraints. 0 2 1 1 0 0
(. GridBagConstraints WEST)
(. GridBagConstraints NONE)
(Insets. 2 2 2 2) 0 0))
(.add (JTextField. 6)
(GridBagConstraints. 1 2 1 1 0 0
(. GridBagConstraints WEST)
(. GridBagConstraints HORIZONTAL)
(Insets. 2 2 2 2) 0 0))
(.add (JLabel. \"Depart:\")
(GridBagConstraints. 0 3 1 1 0 0
(. GridBagConstraints WEST)
(. GridBagConstraints NONE)
(Insets. 2 2 2 2) 0 0))
(.add (JTextField. 6)
(GridBagConstraints. 1 3 1 1 0 0
(. GridBagConstraints WEST)
(. GridBagConstraints HORIZONTAL)
(Insets. 2 2 2 2) 0 0)))
(defmethod print-dup java.awt.GridBagConstraints [args writer]
\"A multimethod for converting java.awt.GridBagConstraints to a compiled form.
@param args a collection of constructor arguments
@param writer the Writer to which the output should be generated\"
(.write writer \"#=(java.awt.GridBagConstraints. \")
(.write writer (apply str (interpose \" \" (map str args))))
(.write writer \")\"))
(defmethod print-dup java.awt.Insets [args writer]
\"A multimethod for converting java.awt.Insets to a compiled form.
@param args a collection of (Integer) constructor arguments
@param writer the Writer to which the output should be generated\"
(.write writer \"#=(java.awt.Insets. \")
(.write writer (apply str (interpose \" \" (map str args))))
(.write writer \")\"))
(defmacro grid-bag-container [container & args]
\"Fill a container having a GridBagLayout with the given components.
The args can start with an optional default-constraints map (see the
doc-string for build-gbc (below) for details on the constraints map).
Following the optional default-constraints are zero or more rows.
Each row is a vector containing either a single component specification
or multiple vectors of component specifications. Each component specification
is a component (e.g.: JButton) followed by one or more key-value constraints
of the same form as the default-constraints. Note that these key-value
pairs are NOT contained in a map. Each row vector will be placed in
the next gridy position (starting with 0). If a row vector contains only
one component specification, that component will be placed at gridx=0.
If a row vector contains vectors, each will be placed at the next gridx
position (starting with 0). The default values for the constraints are as
follows:
:gridwidth 1
:gridheight 1
:weightx 0
:weighty 0
:anchor :WEST
:fill :NONE
:insets (Insets. 5 5 5 5)
:ipadx 0
:ipady 0
For example:
(grid-bag-container
(JPanel.)
{:insets (Insets. 2 2 2 2)} ; Override the default (Insets. 5 5 5 5)
[button :gridwidth 2 :weightx 1] ; Add a button at (gridx=0, gridy=0) with the
; gridwidth=2 (overriding the default 1),
; and weightx=1 (overriding the default 0)
[[label] [textfield :fill :HORIZONTAL]]) ; Add a label at (gridx=0, gridy=1)
; and a textfield at (gridx=1, gridy=1),
; with fill=GridBagContraints.CENTER
; (overriding the default GridBagContraints.WEST)
This example will expand to
(doto container
(.add button (build-gbc {:gridx 0 :gridwidth 2 :ipadx 0 :ipady 0 :anchor :WEST :weighty 0
:gridheight 1 :weightx 1 :fill :NONE :insets (Insets. 2 2 2 2)
:gridy 0}))
(.add label (build-gbc {:gridx 0 :gridwidth 1 :ipadx 0 :ipady 0 :anchor :WEST :weighty 0
:gridheight 1 :weightx 0 :fill :NONE :insets (Insets. 2 2 2 2)
:gridy 1}))
(.add textfield (build-gbc {:gridx 1 :gridwidth 1 :ipadx 0 :ipady 0 :anchor :WEST :weighty 0
:gridheight 1 :weightx 0 :fill :HORIZONTAL :insets (Insets. 2 2 2 2)
:gridy 1})))
@param container the java.awt.Container to fill
@args an optional default-constraints map followed by zero or more row specifications
@returns the container
build-gbc:
Build and return a GridBagConstraints containing the given constraints map.
Each constraint is a (:key value) pair where the name of the key is a
GridBagConstraints field (e.g.: gridwidth) and the value is either a keyword
(e.g.: :CENTER), in which case the GridBagConstraints constant of the same name
(e.g.: GridBagConstraints.CENTER) is used, or anything else, in which case the
corresponding field is set to that value.
Example:
(build-gbc {:gridx 0
:gridy 0
:gridheight 1
:gridwidth 2
:weightx 1
:weighty 0
:anchor :CENTER
:fill :NONE
:insets (Insets. 2 2 2 2)
:ipadx 0
:ipady 0})
will build and return a GridBagConstraints containing the following field values:
gridx 0
gridy 0
gridheight 1
gridwidth 2
weightx 1
weighty 0
anchor GridBagConstraints.CENTER
fill GridBagConstraints.NONE
insets (Insets. 2 2 2 2)
ipadx 0
ipady 0.
@param constraints a map containing the GridBagConstraints constraint values
@returns a new GridBagConstraints
@see http://stuartsierra.com/2010/01/05/taming-the-gridbaglayout\"
(let [global-defaults {:gridwidth 1
:gridheight 1
:weightx 0
:weighty 0
:anchor :WEST
:fill :NONE
:insets (Insets. 5 5 5 5)
:ipadx 0
:ipady 0}
defaults
(if (map? (first args))
(first args)
{})
args
(into []
(if (map? (first args))
(rest args)
args))
build-gbc
(fn [constraints]
(let [process-value
#(if (nil? %)
nil
(if (keyword? %)
`(. GridBagConstraints ~(symbol (name %)))
%))]
`(GridBagConstraints.
~(process-value (:gridx constraints))
~(process-value (:gridy constraints))
~(process-value (:gridwidth constraints))
~(process-value (:gridheight constraints))
~(process-value (:weightx constraints))
~(process-value (:weighty constraints))
~(process-value (:anchor constraints))
~(process-value (:fill constraints))
~(process-value (:insets constraints))
~(process-value (:ipadx constraints))
~(process-value (:ipady constraints)))))]
`(doto ~container
~@(loop [end (count args)
gridy 0
ret []]
(if (= end gridy)
ret
(let [row (nth args gridy)
process-item
(fn [component gridx gridy constraints]
(let [constraints
(reduce into global-defaults
[{:gridx gridx :gridy gridy}
defaults
(vec (map vec (partition 2 constraints)))])]
`(.add ~component ~(build-gbc constraints))))]
(if (vector? (first row))
(recur end
(inc gridy)
(into ret (for [gridx (range (count row))
:let [item (nth row gridx)
component (first item)
constraints (rest item)]]
(process-item component gridx gridy constraints))))
(recur end
(inc gridy)
(conj ret (let [component (first row)
constraints (rest row)]
(process-item component 0 gridy constraints)))))))))))
没有找到相关结果
已邀请:
1 个回复
咳累录酬
应该改为或类似的值。 打印重复代码很混乱，不需要使用，因此就省去了。