Permalink
Browse files

Split to-widget into two parts, to-widget for conversion and make-wid…

…get for construction.
  • Loading branch information...
1 parent 075ecef commit 42ced87f22d4fd3002d064b959f7261d32da6eee @daveray committed Jul 23, 2011
Showing with 115 additions and 92 deletions.
  1. +48 −43 src/seesaw/core.clj
  2. +10 −11 src/seesaw/examples/to_widget.clj
  3. +2 −2 src/seesaw/forms.clj
  4. +23 −16 src/seesaw/to_widget.clj
  5. +32 −20 test/seesaw/test/core.clj
View
91 src/seesaw/core.clj
@@ -143,12 +143,13 @@
;*******************************************************************************
; Widget coercion prototcol
-(defn ^java.awt.Component to-widget
- "Try to convert the input argument to a widget based on the following rules:
-
+(defn ^java.awt.Component make-widget
+ "Try to create a new widget based on the following rules:
+
nil -> nil
- java.awt.Component -> return argument unchanged
- java.util.EventObject -> return the event source
+ java.awt.Component -> return argument unchanged (like to-widget)
+ java.util.EventObject -> return the event source (like to-widget)
+
java.awt.Dimension -> return Box/createRigidArea
java.swing.Action -> return a button using the action
:separator -> create a horizontal JSeparator
@@ -157,18 +158,22 @@
[:fill-h n] -> Box/createHorizontalStrut with width n
[:fill-v n] -> Box/createVerticalStrut with height n
[width :by height] -> create rigid area with given dimensions
- A java.net.URL -> a label with the image located at the url
+ java.net.URL -> a label with the image located at the url
Anything else -> a label with the text from passing the object through str
+ "
+ ([v] (when v (make-widget* v))))
+
+(defn ^java.awt.Component to-widget
+ "Try to convert the input argument to a widget based on the following rules:
- If create? is false, will return nil for all rules (see above) that
- would create a new widget. The default value for create? is false
- to avoid inadvertently creating widgets all over the place.
+ nil -> nil
+ java.awt.Component -> return argument unchanged
+ java.util.EventObject -> return the event source
See:
(seeseaw.to-widget)
"
- ([v] (to-widget v false))
- ([v create?] (when v (to-widget* v create?))))
+ ([v] (when v (to-widget* v))))
;*******************************************************************************
; Widget construction stuff
@@ -467,7 +472,7 @@
(defn- add-widget
([c w] (add-widget c w nil))
([^java.awt.Container c w constraint]
- (let [w* (to-widget w true)]
+ (let [w* (make-widget w)]
(check-args (not (nil? w*)) (str "Can't add nil widget. Original was (" w ")"))
(.add c w* constraint)
w*)))
@@ -674,7 +679,7 @@
(extend-protocol ConfigureWidget
java.util.EventObject
- (config* [target args] (config* (to-widget target false) args))
+ (config* [target args] (config* (to-widget target) args))
java.awt.Component
(config* [target args] (reapply-options target args default-options))
@@ -769,11 +774,11 @@
"Create a panel with a border layout. In addition to the usual options,
supports:
- :north widget for north position (passed through to-widget)
- :south widget for south position (passed through to-widget)
- :east widget for east position (passed through to-widget)
- :west widget for west position (passed through to-widget)
- :center widget for center position (passed through to-widget)
+ :north widget for north position (passed through make-widget)
+ :south widget for south position (passed through make-widget)
+ :east widget for east position (passed through make-widget)
+ :west widget for west position (passed through make-widget)
+ :center widget for center position (passed through make-widget)
:hgap horizontal gap between widgets
:vgap vertical gap between widgets
@@ -853,7 +858,7 @@
(defn flow-panel
"Create a panel with a flow layout. Options:
- :items List of widgets (passed through to-widget)
+ :items List of widgets (passed through make-widget)
:hgap horizontal gap between widgets
:vgap vertical gap between widgets
:align :left, :right, :leading, :trailing, :center
@@ -881,7 +886,7 @@
(defn horizontal-panel
"Create a panel where widgets are arranged horizontally. Options:
- :items List of widgets (passed through to-widget)
+ :items List of widgets (passed through make-widget)
See http://download.oracle.com/javase/6/docs/api/javax/swing/BoxLayout.html
"
@@ -891,7 +896,7 @@
(defn vertical-panel
"Create a panel where widgets are arranged vertically Options:
- :items List of widgets (passed through to-widget)
+ :items List of widgets (passed through make-widget)
See http://download.oracle.com/javase/6/docs/api/javax/swing/BoxLayout.html
"
@@ -911,7 +916,7 @@
:rows Number of rows, defaults to 0, i.e. unspecified.
:columns Number of columns.
- :items List of widgets (passed through to-widget)
+ :items List of widgets (passed through make-widget)
:hgap horizontal gap between widgets
:vgap vertical gap between widgets
@@ -1075,7 +1080,7 @@
radio buttons, toggle-able menus, etc. Takes the following options:
:buttons A sequence of buttons to include in the group. They are *not*
- passed through (to-widget), i.e. they must be button or menu
+ passed through (make-widget), i.e. they must be button or menu
instances.
The mutual exclusion of the buttons in the group will be maintained automatically.
@@ -1562,20 +1567,20 @@
})
(defn- set-scrollable-corner [k ^JScrollPane w v]
- (.setCorner w (scrollable-corner-constants k) (to-widget v true)))
+ (.setCorner w (scrollable-corner-constants k) (make-widget v)))
(def ^{:private true} scrollable-options (merge {
:hscroll #(.setHorizontalScrollBarPolicy ^JScrollPane %1 (hscroll-table %2))
:vscroll #(.setVerticalScrollBarPolicy ^JScrollPane %1 (vscroll-table %2))
:row-header
(fn [^JScrollPane w v]
- (let [v (to-widget v true)]
+ (let [v (make-widget v)]
(if (instance? javax.swing.JViewport v)
(.setRowHeader w v)
(.setRowHeaderView w v))))
:column-header
(fn [^JScrollPane w v]
- (let [v (to-widget v true)]
+ (let [v (make-widget v)]
(if (instance? javax.swing.JViewport v)
(.setColumnHeader w v)
(.setColumnHeaderView w v))))
@@ -1617,7 +1622,7 @@
"
[target & opts]
(let [^JScrollPane sp (construct JScrollPane opts)]
- (.setViewportView sp (to-widget target true))
+ (.setViewportView sp (make-widget target))
(apply-options sp opts (merge default-options scrollable-options))))
;*******************************************************************************
@@ -1698,8 +1703,8 @@
(doto ^JSplitPane (construct JSplitPane opts)
(.setOrientation (dir {:left-right JSplitPane/HORIZONTAL_SPLIT
:top-bottom JSplitPane/VERTICAL_SPLIT}))
- (.setLeftComponent (to-widget left true))
- (.setRightComponent (to-widget right true)))
+ (.setLeftComponent (make-widget left))
+ (.setRightComponent (make-widget right)))
opts
(merge default-options splitter-options)))
@@ -1782,7 +1787,7 @@
(.add menu menu-item)
(if (= :separator item)
(.addSeparator menu)
- (.add menu (to-widget item true))))))
+ (.add menu (make-widget item))))))
})
(defn menu
@@ -1807,7 +1812,7 @@
(.add menu menu-item)
(if (= :separator item)
(.addSeparator menu)
- (.add menu (to-widget item true))))))
+ (.add menu (make-widget item))))))
})
(defn popup
@@ -1916,7 +1921,7 @@
(let [title-cmp (try-cast Component title)
index (.getTabCount tp)]
(cond-doto tp
- true (.addTab (when-not title-cmp (str title)) (make-icon icon) (to-widget content true) (str tip))
+ true (.addTab (when-not title-cmp (str title)) (make-icon icon) (make-widget content) (str tip))
title-cmp (.setTabComponentAt index title-cmp))))
tp)
@@ -1938,7 +1943,7 @@
:title Title of the tab or a component to be displayed.
:tip Tab's tooltip text
:icon Tab's icon, passed through (icon)
- :content The content of the tab, passed through (to-widget) as usual.
+ :content The content of the tab, passed through (make-widget) as usual.
Returns the new JTabbedPane.
@@ -2078,7 +2083,7 @@
:id seesaw.selector/id-of!
:class seesaw.selector/class-of!
:on-close #(.setDefaultCloseOperation ^javax.swing.JFrame %1 (frame-on-close-map %2))
- :content #(.setContentPane ^javax.swing.JFrame %1 (to-widget %2 true))
+ :content #(.setContentPane ^javax.swing.JFrame %1 (make-widget %2))
:menubar #(.setJMenuBar ^javax.swing.JFrame %1 %2)
:title #(.setTitle ^java.awt.Frame %1 (str %2))
@@ -2098,7 +2103,7 @@
:height initial height. Note that calling (pack!) will negate this setting
:size initial size. Note that calling (pack!) will negate this setting
:minimum-size minimum size of frame, e.g. [640 :by 480]
- :content passed through (to-widget) and used as the frame's content-pane
+ :content passed through (make-widget) and used as the frame's content-pane
:visible? whether frame should be initially visible (default false)
:resizable? whether the frame can be resized (default true)
:on-close default close behavior. One of :exit, :hide, :dispose, :nothing
@@ -2186,7 +2191,7 @@
; These two override frame-options for purposes of type hinting and reflection
:on-close #(.setDefaultCloseOperation ^javax.swing.JDialog %1 (frame-on-close-map %2))
- :content #(.setContentPane ^javax.swing.JDialog %1 (to-widget %2 true))
+ :content #(.setContentPane ^javax.swing.JDialog %1 (make-widget %2))
:menubar #(.setJMenuBar ^javax.swing.JDialog %1 %2)
; Ditto here. Avoid reflection
@@ -2440,7 +2445,7 @@
:type The type of the dialog. One of :warning, :error, :info, :plain, or :question.
:options Custom buttons/options can be provided using this argument.
- It must be a seq of \"to-widget\"'able objects which will be
+ It must be a seq of \"make-widget\"'able objects which will be
displayed as options the user can choose from. Note that in this
case, :success-fn, :cancel-fn & :no-fn will *not* be called.
Use the handlers on those buttons & RETURN-FROM-DIALOG to close
@@ -2498,7 +2503,7 @@
(dialog-option-type-map option-type)
nil ;icon
(when options
- (into-array (map #(to-widget % true) options)))
+ (into-array (map make-widget options)))
(or default-option (first options))) ; default selection
remaining-opts (apply dissoc opts :visible? (keys dialog-defaults))
dlg (apply custom-dialog :visible? false :content pane (reduce concat remaining-opts))]
@@ -2801,10 +2806,10 @@
container))
(defn replace!
- "Replace old-widget with new-widget from container. container and each widget
- are passed through (to-widget) as usual. Note that the layout constraints of
- old-widget are retained for the new widget. This is different from the behavior
- you'd get with just remove/add in Swing.
+ "Replace old-widget with new-widget from container. container and old-widget
+ are passed through (to-widget). new-widget is passed through make-widget.
+ Note that the layout constraints of old-widget are retained for the new widget.
+ This is different from the behavior you'd get with just remove/add in Swing.
The container is properly revalidated and repainted after replacement.
@@ -2819,5 +2824,5 @@
"
[container old-widget new-widget]
(handle-structure-change
- (replace!-impl (to-widget container) (to-widget old-widget) (to-widget new-widget true))))
+ (replace!-impl (to-widget container) (to-widget old-widget) (make-widget new-widget))))
View
21 src/seesaw/examples/to_widget.clj
@@ -19,18 +19,17 @@
(defn name-field [person field]
(text :columns 15 :text (field person)))
-; Now implement ToWidget to create an editor for that type
+; Now implement MakeWidget to create an editor for that type
(extend-type Person
- ToWidget
- (to-widget* [person create?]
- (when create?
- (mig-panel :constraints ["", "[][grow]"]
- :border [(line-border :thickness 1) 5]
- :items [
- [ "First Name" "gap 10"]
- [ (name-field person :first-name) "growx, wrap"]
- [ "Last Name" "gap 10"]
- [ (name-field person :last-name) "growx"]]))))
+ MakeWidget
+ (make-widget* [person]
+ (mig-panel :constraints ["", "[][grow]"]
+ :border [(line-border :thickness 1) 5]
+ :items [
+ [ "First Name" "gap 10"]
+ [ (name-field person :first-name) "growx, wrap"]
+ [ "Last Name" "gap 10"]
+ [ (name-field person :last-name) "growx"]])))
; Make some people
View
4 src/seesaw/forms.clj
@@ -24,7 +24,7 @@
(extend-protocol ComponentSpec
Object
(append [this builder]
- (.append builder (seesaw.core/to-widget this true)))
+ (.append builder (seesaw.core/make-widget this)))
String
(append [this builder]
(.append builder this)))
@@ -35,7 +35,7 @@
(reify
ComponentSpec
(append [this builder]
- (.append builder (seesaw.core/to-widget component true) column-span))))
+ (.append builder (seesaw.core/make-widget component) column-span))))
(defn next-line
"Continue with the nth next line in the builder."
View
39 src/seesaw/to_widget.clj
@@ -13,53 +13,60 @@
(:import [java.awt Dimension]
[javax.swing Box JLabel JButton]))
-(defprotocol ToWidget (to-widget* [v create?]))
+(defprotocol ToWidget
+ (to-widget* [v]))
+
+(defprotocol MakeWidget
+ (make-widget* [v]))
; A couple macros to make definining the ToWidget protocol a little less
; tedious. Mostly just for fun...
-(defmacro ^{:private true} def-widget-coercion [t b & forms]
+(defmacro ^{:private true} def-to-widget [t b & forms]
`(extend-type
~t
ToWidget
- (~'to-widget* [~(first b) create?#] ~@forms)))
+ (~'to-widget* ~b ~@forms)))
-(defmacro ^{:private true} def-widget-creational-coercion [t b & forms]
+(defmacro ^{:private true} def-make-widget [t b & forms]
`(extend-type
~t
- ToWidget
- (~'to-widget* [~(first b) create?#] (when create?# ~@forms))))
+ MakeWidget
+ (~'make-widget* ~b ~@forms)))
-; ... for example, a component coerces to itself.
-(def-widget-coercion java.awt.Component [c] c)
+(def-to-widget Object [c] nil)
-(def-widget-coercion java.util.EventObject
+(def-to-widget java.awt.Component [c] c)
+
+(def-to-widget java.util.EventObject
[v]
(try-cast java.awt.Component (.getSource v)))
-(def-widget-creational-coercion java.awt.Dimension [v] (Box/createRigidArea v))
+(def-make-widget java.awt.Component [c] c)
+
+(def-make-widget java.awt.Dimension [v] (Box/createRigidArea v))
-(def-widget-creational-coercion javax.swing.Action [v] (JButton. v))
+(def-make-widget javax.swing.Action [v] (JButton. v))
-(def-widget-creational-coercion clojure.lang.Keyword
+(def-make-widget clojure.lang.Keyword
[v]
(condp = v
:separator (javax.swing.JSeparator.)
:fill-h (Box/createHorizontalGlue)
:fill-v (Box/createVerticalGlue)))
-(def-widget-creational-coercion clojure.lang.IPersistentVector
+(def-make-widget clojure.lang.IPersistentVector
[[v0 v1 v2]]
(cond
(= :fill-h v0) (Box/createHorizontalStrut v1)
(= :fill-v v0) (Box/createVerticalStrut v1)
(= :by v1) (Box/createRigidArea (Dimension. v0 v2))))
-(def-widget-creational-coercion Object
+(def-make-widget String
[v]
- (JLabel. (str v)))
+ (JLabel. v))
-(def-widget-creational-coercion java.net.URL
+(def-make-widget java.net.URL
[v]
(JLabel. (icon v)))
View
52 test/seesaw/test/core.clj
@@ -201,61 +201,73 @@
(it "hides a widget and returns it"
(not (.isVisible (hide! (doto (JPanel.) (.setVisible true)))))))
-(describe to-widget
+(describe make-widget
+ (it "throws an exception for unsupported arguments"
+ (try (make-widget 99) false (catch Exception e true)))
(it "returns nil if input is nil"
- (= nil (to-widget nil)))
+ (= nil (make-widget nil)))
(it "returns input if it's already a widget"
(let [c (JPanel.)]
- (expect (= c (to-widget c)))))
+ (expect (= c (make-widget c)))))
(it "returns input if it's a JFrame"
(let [c (JFrame.)]
- (expect (= c (to-widget c)))))
- (it "does not create a new widget if create? param is false"
- (expect (nil? (to-widget "HI" false))))
- (it "returns a label for text input"
- (let [c (to-widget "TEST" true)]
+ (expect (= c (make-widget c)))))
+ (it "returns a label for string input"
+ (let [c (make-widget "TEST")]
(expect (= "TEST" (.getText c)))))
(it "returns a button if input is an Action"
(let [a (action :handler #(println "HI") :name "Test")
- c (to-widget a true)]
+ c (make-widget a)]
(expect (isa? (class c) javax.swing.JButton))
(expect (= "Test" (.getText c)))))
(it "creates a separator for :separator"
- (expect (= javax.swing.JSeparator (class (to-widget :separator true)))))
+ (expect (= javax.swing.JSeparator (class (make-widget :separator)))))
(it "creates horizontal glue for :fill-h"
- (let [c (to-widget :fill-h true)]
+ (let [c (make-widget :fill-h)]
(expect (isa? (class c) javax.swing.Box$Filler ))
(expect (= 32767 (.. c getMaximumSize getWidth)))))
(it "creates vertical glue for :fill-v"
- (let [c (to-widget :fill-v true)]
+ (let [c (make-widget :fill-v)]
(expect (isa? (class c) javax.swing.Box$Filler))
(expect (= 32767 (.. c getMaximumSize getHeight)))))
(it "creates a vertical strut for [:fill-v N]"
- (let [c (to-widget [:fill-v 99] true)]
+ (let [c (make-widget [:fill-v 99])]
(expect (isa? (class c) javax.swing.Box$Filler))
(expect (= 32767 (.. c getMaximumSize getWidth)))
(expect (= 99 (.. c getMaximumSize getHeight)))
(expect (= 99 (.. c getPreferredSize getHeight)))))
(it "creates a horizontal strut for [:fill-h N]"
- (let [c (to-widget [:fill-h 88] true)]
+ (let [c (make-widget [:fill-h 88])]
(expect (isa? (class c) javax.swing.Box$Filler))
(expect (= 32767 (.. c getMaximumSize getHeight)))
(expect (= 88 (.. c getMaximumSize getWidth)))
(expect (= 88 (.. c getPreferredSize getWidth)))))
(it "creates a rigid area for a Dimension"
- (let [c (to-widget (Dimension. 12 34) true)]
+ (let [c (make-widget (Dimension. 12 34))]
(expect (isa? (class c) javax.swing.Box$Filler))
(expect (= 12 (.. c getMaximumSize getWidth)))
(expect (= 34 (.. c getMaximumSize getHeight)))
(expect (= 12 (.. c getPreferredSize getWidth)))
(expect (= 34 (.. c getPreferredSize getHeight)))))
(it "creates a rigid area for a [N :by N]"
- (let [c (to-widget [12 :by 34] true)]
+ (let [c (make-widget [12 :by 34])]
(expect (isa? (class c) javax.swing.Box$Filler))
(expect (= 12 (.. c getMaximumSize getWidth)))
(expect (= 34 (.. c getMaximumSize getHeight)))
(expect (= 12 (.. c getPreferredSize getWidth)))
- (expect (= 34 (.. c getPreferredSize getHeight)))))
+ (expect (= 34 (.. c getPreferredSize getHeight))))))
+
+(describe to-widget
+ (it "returns nil for unknown inputs"
+ (= nil (to-widget "a string")))
+ (it "returns nil if input is nil"
+ (= nil (to-widget nil)))
+ (it "returns input if it's already a widget"
+ (let [c (JPanel.)]
+ (expect (= c (to-widget c)))))
+ (it "returns input if it's a JFrame"
+ (let [c (JFrame.)]
+ (expect (= c (to-widget c)))))
(it "converts an event to its source"
(let [b (button)
e (ActionEvent. b 0 "hi")]
@@ -993,10 +1005,10 @@
(let [dlg (dialog :content "Nothing" :modal? false)]
(expect (= (test-dlg-blocking dlg) dlg))))
(testing "return-from-dialog"
- (let [ok (to-widget (action :name "Ok" :handler (fn [e] (return-from-dialog e :ok))) true)
- cancel (to-widget (action :name "Cancel" :handler (fn [e] (return-from-dialog e :cancel))) true)
+ (let [ok (make-widget (action :name "Ok" :handler (fn [e] (return-from-dialog e :ok))))
+ cancel (make-widget (action :name "Cancel" :handler (fn [e] (return-from-dialog e :cancel))))
dlg (dialog :content "Nothing"
- :options (map #(to-widget % true) [ok cancel]))]
+ :options (map make-widget [ok cancel]))]
(it "should return value passed to RETURN-FROM-DIALOG from clicking on ok button"
(expect (= (test-dlg-blocking
dlg

0 comments on commit 42ced87

Please sign in to comment.