Skip to content

Commit

Permalink
Finished merging in atom/property sync changes
Browse files Browse the repository at this point in the history
  • Loading branch information
@daveray
daveray committed Jun 2, 2011
2 parents ea00c70 + e7017e1 commit a6da722
Show file tree
Hide file tree
Showing 7 changed files with 300 additions and 73 deletions.
195 changes: 142 additions & 53 deletions src/seesaw/core.clj
View file
Expand Up @@ -9,7 +9,8 @@
; You must not remove this notice, or any other, from this software.

(ns seesaw.core
(:use [seesaw util font border color meta])
(:use [seesaw util font border color meta]
[clojure.string :only (capitalize split)])
(:require [seesaw.event :as sse]
[seesaw.timer :as sst]
[seesaw.selection :as sss]
Expand Down Expand Up @@ -459,30 +460,137 @@
(instance? java.awt.Rectangle v) (.setBounds w v)
:else (.setBounds w (nth v 0) (nth v 1) (nth v 2) (nth v 3))))


;*******************************************************************************
; Widget configuration stuff
(defprotocol ConfigureWidget (config* [target args]))

(defn config!
"Applies properties in the argument list to one or more targets. For example:
(config! button1 :enabled? false :text \"I' disabled\")
or:
(config! [button1 button2] :enabled? false :text \"We're disabled\")
Targets may be actual widgets, or convertible to widgets with (to-widget).
For example, the target can be an event object.
Returns the input targets."
[targets & args]
(doseq [target (to-seq targets)]
(config* target args))
targets)


;*******************************************************************************
; Property<->Atom syncing

(def ^{:private true} short-property-keywords-to-long-map
{:min :minimum
:max :maximum
:tip :tool-tip-text})

(defn- kw->java-name
"(kw->java-name :preferred-size)"
[kw]
(reduce str
(map capitalize (split (-> (name kw)
(.replace "?" ""))
#"\-"))))

(defn property-kw->java-name
"INTERNAL USE ONLY. DO NOT USE
(property-kw->java-name :tip)"
[kw]
(apply str
(map capitalize (split (-> (short-property-keywords-to-long-map kw kw)
name
(.replace "?" ""))
#"\-"))))

(defn- kw->java-method
"USED ONLY BY TESTS. DO NOT USE.
(kw->java-method :enabled?)"
[kw]
(str (if (.endsWith (str kw) "?")
"is"
"get") (kw->java-name kw)))

(defn property-kw->java-method
"USED ONLY BY TESTS. DO NOT USE.
(property-kw->java-method :tip)"
[kw]
(kw->java-method (get short-property-keywords-to-long-map kw kw)))

;; by default, property names' first character will be lowercased when
;; added using a property change listener. For some however, the first
;; character must stay uppercased. This map will specify those exceptions.
(def ^{:private true} property-change-listener-name-overrides {
"ToolTipText" "ToolTipText"
})

(defmulti ^{:private true} setup-property-change-on-atom (fn [c k a] [(type c) k]))

(defmethod ^{:private true} setup-property-change-on-atom :default
[component property a]
(let [property-name (property-kw->java-name property)]
(.addPropertyChangeListener
component
; first letter of *some* property-names must be lower-case
(property-change-listener-name-overrides
property-name
(apply str (clojure.string/lower-case (first property-name)) (rest property-name)))
(proxy [java.beans.PropertyChangeListener] []
(propertyChange [e] (reset! a (.getNewValue e)))))))

(defn- setup-property-syncing
[component property-name a]
(add-watch a
(keyword (gensym "property-syncing-watcher"))
(fn atom-watcher-fn
[k r o n] (when-not (= o n)
(invoke-now (config! component
property-name
n)))))
(setup-property-change-on-atom component property-name a))

(defn- ensure-sync-when-atom
[component property-name atom-or-other]
(if (atom? atom-or-other)
(do (setup-property-syncing component property-name atom-or-other) @atom-or-other)
atom-or-other))


;*******************************************************************************
; Default options
(def ^{:private true} default-options {
:id id-option-handler
:listen #(apply sse/listen %1 %2)
:opaque? #(.setOpaque %1 (boolean %2))
:enabled? #(.setEnabled %1 (boolean %2))
:background #(do (.setBackground %1 (to-color %2))
(.setOpaque %1 true))
:foreground #(.setForeground %1 (to-color %2))
:border #(.setBorder %1 (to-border %2))
:font #(.setFont %1 (to-font %2))
:tip #(.setToolTipText %1 (str %2))
:text #(.setText %1 (str %2))
:icon #(.setIcon %1 (make-icon %2))
:action #(.setAction %1 %2)
:editable? #(.setEditable %1 (boolean %2))
:visible? #(.setVisible %1 (boolean %2))
:opaque? #(.setOpaque %1 (boolean (ensure-sync-when-atom %1 :opaque? %2)))
:enabled? #(.setEnabled %1 (boolean (ensure-sync-when-atom %1 :enabled? %2)))
:background #(do
(let [v (ensure-sync-when-atom %1 :background %2)]
(.setBackground %1 (to-color v))
(.setOpaque %1 true)))
:foreground #(.setForeground %1 (to-color (ensure-sync-when-atom %1 :foreground %2)))
:border #(.setBorder %1 (to-border (ensure-sync-when-atom %1 :border %2)))
:font #(.setFont %1 (to-font (ensure-sync-when-atom %1 :font %2)))
:tip #(.setToolTipText %1 (str (ensure-sync-when-atom %1 :tip %2)))
:text #(.setText %1 (str (ensure-sync-when-atom %1 :text %2)))
:icon #(.setIcon %1 (make-icon (ensure-sync-when-atom %1 :icon %2)))
:action #(.setAction %1 (ensure-sync-when-atom %1 :action %2))
:editable? #(.setEditable %1 (boolean (ensure-sync-when-atom %1 :editable? %2)))
:visible? #(.setVisible %1 (boolean (ensure-sync-when-atom %1 :visible? %2)))
:halign #(.setHorizontalAlignment %1 (h-alignment-table %2))
:valign #(.setVerticalAlignment %1 (v-alignment-table %2))
:orientation #(.setOrientation %1 (orientation-table %2))
:orientation #(.setOrientation %1 (orientation-table (ensure-sync-when-atom %1 :orientation %2)))
:items #(add-widgets %1 %2)
:model #(.setModel %1 %2)
:preferred-size #(.setPreferredSize %1 (to-dimension %2))
:minimum-size #(.setMinimumSize %1 (to-dimension %2))
:maximum-size #(.setMaximumSize %1 (to-dimension %2))
:preferred-size #(.setPreferredSize %1 (to-dimension (ensure-sync-when-atom %1 :preferred-size %2)))
:minimum-size #(.setMinimumSize %1 (to-dimension (ensure-sync-when-atom %1 :minimum-size %2)))
:maximum-size #(.setMaximumSize %1 (to-dimension (ensure-sync-when-atom %1 :maximum-size %2)))
:size #(let [d (to-dimension %2)]
(doto %1
(.setPreferredSize d)
Expand All @@ -493,17 +601,6 @@
:popup #(popup-option-handler %1 %2)
})

(defn apply-default-opts
"only used in tests!"
([p] (apply-default-opts p {}))
([^javax.swing.JComponent p {:as opts}]
(apply-options p opts default-options)))

;*******************************************************************************
; Widget configuration stuff

(defprotocol ConfigureWidget (config* [target args]))

(extend-type java.util.EventObject ConfigureWidget
(config* [target args] (config* (to-widget target false) args)))

Expand All @@ -523,23 +620,11 @@
(config* [target args]
(reapply-options target args default-options)))

(defn config!
"Applies properties in the argument list to one or more targets. For example:
(config! button1 :enabled? false :text \"I' disabled\")
or:
(config! [button1 button2] :enabled? false :text \"We're disabled\")
Targets may be actual widgets, or convertible to widgets with (to-widget).
For example, the target can be an event object.
Returns the input targets."
[targets & args]
(doseq [target (to-seq targets)]
(config* target args))
targets)
(defn apply-default-opts
"only used in tests!"
([p] (apply-default-opts p {}))
([^javax.swing.JComponent p {:as opts}]
(apply-options p opts default-options)))

;*******************************************************************************
; ToDocument
Expand Down Expand Up @@ -1894,15 +1979,19 @@

;*******************************************************************************
; Slider
(defmethod ^{:private true} setup-property-change-on-atom [javax.swing.JSlider :value]
[component _ a]
(listen component
:change
(fn [e]
(reset! a (.getValue component)))))

(def ^{:private true} slider-options {
:orientation #(.setOrientation %1 (or (orientation-table %2)
(throw (IllegalArgumentException. (str ":orientation must be either :horizontal or :vertical. Got " %2 " instead.")))))
:value #(cond (isa? (type %2) clojure.lang.Atom)
(ssb/bind-atom-to-range-model %2 (.getModel %1))
(number? %2)
(.setValue %1 %2)
:else
(throw (IllegalArgumentException. ":value must be a number or an atom.")))
:value #(let [v (ensure-sync-when-atom %1 :value %2)]
(check-args (number? v) ":value must be a number or an atom.")
(.setValue %1 v))
:min #(do (check-args (number? %2) ":min must be a number.")
(.setMinimum %1 %2))
:max #(do (check-args (number? %2) ":max must be a number.")
Expand Down Expand Up @@ -1967,7 +2056,7 @@
(def ^{:private true} progress-bar-options {
:orientation #(.setOrientation %1 (or (orientation-table %2)
(throw (IllegalArgumentException. (str ":orientation must be either :horizontal or :vertical. Got " %2 " instead.")))))
:value #(cond (isa? (type %2) clojure.lang.Atom)
:value #(cond (atom? %2)
(ssb/bind-atom-to-range-model %2 (.getModel %1))
(number? %2)
(.setValue %1 %2)
Expand Down
44 changes: 41 additions & 3 deletions src/seesaw/examples/dialog.clj
View file
Expand Up @@ -9,7 +9,7 @@
; You must not remove this notice, or any other, from this software.

(ns seesaw.examples.dialog
(:use [seesaw core font border]))
(:use [seesaw core font border util color pref]))

(let [common-opts
[:content (mig-panel :items [[(label :font (font :from (default-font "Label.font")
Expand All @@ -35,7 +35,43 @@
(concat [:options [(action :name "Save" :handler (fn [e] (return-from-dialog :save)))
(action :name "Delete" :handler (fn [e] (return-from-dialog :delete)))
(action :name "Cancel" :handler (fn [e] (return-from-dialog nil)))]]
common-opts))))
common-opts)))
(defn open-display-options-remembered-dlg
[]
(dialog :id :dlg
;;:options [ok-act cancel-act]
:success-fn (fn [p]
(let [knn (selection (select (to-frame p) [:#knn]))]
[[(selection (select (to-frame p) [:#mesh-p])) (selection (select (to-frame p) [:#plot-p]))]
(selection (select (to-frame p) [:#angle]))
(selection (select (to-frame p) [:#mode]))
(.getBackground (select (to-frame p) [:#colorbtn]))
knn]))
:cancel-fn (fn [p] nil)
:option-type :ok-cancel
:content (mig-panel :items
[[(label :font (font :from (.getFont (javax.swing.UIManager/getDefaults) "Label.font")
:style :bold)
:text "Display options for new geometry") "gaptop 10, wrap"]
[:separator "growx, wrap, gaptop 10, spanx 2"]
["Generate"]
[(checkbox :id :mesh-p :text "Mesh") "split"]
[(checkbox :id :plot-p :text "Plot") "wrap"]
["Display mode"]
[(combobox :id :mode :model ["Triangulated Mesh" "Lines"]) "wrap"]
["Angle"]
[(slider :id :angle :value (bind-preference-to-atom "LAST_ANGLE" 150) :min 0 :max 20 :minor-tick-spacing 1 :major-tick-spacing 20 :paint-labels? true) "wrap"]
["KNN"]
[(slider :id :knn :value (bind-preference-to-atom "LAST_KNN" 150) :min 0 :max 300
:minor-tick-spacing 10 :major-tick-spacing 100 :paint-labels? true)
"wrap"]
["Color"]
[(label :id :colorbtn :text " " :background (bind-preference-to-atom "LAST_BACKGROUND" (color 255 255 0))
:listen [:mouse-clicked
(fn [e]
(if-let [clr (javax.swing.JColorChooser/showDialog nil "Choose a color" (.getBackground (.getSource e)))]
(config! (.getSource e) :background clr)))]) "growx, wrap"]
]))))

(defn -main [& args]
(invoke-later
Expand All @@ -44,5 +80,7 @@
:content (vertical-panel :items [(action :name "Show Dialog with custom :success-fn"
:handler (fn [e] (alert (str "Result = " (open-display-options-dlg)))))
(action :name "Show Dialog with custom option buttons"
:handler (fn [e] (alert (str "Result = " (open-display-options-custom-dlg)))))]))))
:handler (fn [e] (alert (str "Result = " (open-display-options-custom-dlg)))))
(action :name "Show Dialog with remembered values"
:handler (fn [e] (alert (str "Result = " (open-display-options-remembered-dlg)))))]))))
;(-main)
34 changes: 34 additions & 0 deletions src/seesaw/pref.clj
View file
@@ -0,0 +1,34 @@
; Copyright (c) Dave Ray, 2011. All rights reserved.

; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
; which can be found in the file epl-v10.html at the root of this
; distribution.
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
; You must not remove this notice, or any other, from this software.

(ns seesaw.pref)

(defmacro preferences-node
"Return the java.util.prefs.Preferences/userRoot for the current
namespace."
[]
`(.node (java.util.prefs.Preferences/userRoot) ~(str (ns-name *ns*))))

(defn bind-preference-to-atom
"Generate and return an atom, which will automatically be synced
with (java.util.prefs.Preferences/userRoot) for the current
namespace and a given string KEY. If not yet set, the atom will have
INITIAL-VALUE as its value, or the value which has already been set
inside the preferences. Note that the value must be printable per
PRINT-DUP and readable per READ-STRING for it to be used with the
preferences store."
[key initial-value]
; TODO This doesn't work because preferences-node will store in the seesaw.pref
; namespace, not the namespace of the caller!
(let [v (atom (read-string (.get (preferences-node) key (binding [*print-dup* true] (pr-str initial-value)))))]
(add-watch v (keyword (gensym "pref-atom-watcher"))
(fn [k r o n] (when (not= o n)
(.put (preferences-node) key (binding [*print-dup* true] (pr-str n))))))))

4 changes: 4 additions & 0 deletions src/seesaw/util.clj
View file
Expand Up @@ -80,6 +80,10 @@
provided."
(or (true? b) (false? b)))

(defn atom? [a]
"Return true if a is an atom"
(isa? (type a) clojure.lang.Atom))

(defn try-cast [c x]
"Just like clojure.core/cast, but returns nil on failure rather than throwing ClassCastException"
(try
Expand Down

0 comments on commit a6da722

Please sign in to comment.