├── .gitignore
├── .idea
├── .name
├── codeStyleSettings.xml
├── compiler.xml
├── copyright
│ └── profiles_settings.xml
├── encodings.xml
├── inspectionProfiles
│ ├── Project_Default.xml
│ └── profiles_settings.xml
├── leiningen.xml
├── libraries
│ ├── Leiningen__clojure_complete_0_2_4.xml
│ ├── Leiningen__com_vaadin_external_flute_flute_1_3_0_gg2.xml
│ ├── Leiningen__com_vaadin_vaadin_client_compiled_7_7_9.xml
│ ├── Leiningen__com_vaadin_vaadin_sass_compiler_0_9_13.xml
│ ├── Leiningen__com_vaadin_vaadin_server_7_7_9.xml
│ ├── Leiningen__com_vaadin_vaadin_shared_7_7_9.xml
│ ├── Leiningen__com_vaadin_vaadin_themes_7_7_9.xml
│ ├── Leiningen__commons_io_2_4.xml
│ ├── Leiningen__io_reactivex_rxclojure_1_0_0.xml
│ ├── Leiningen__io_reactivex_rxjava_1_0_1.xml
│ ├── Leiningen__javax_servlet_javax_servlet_api_3_1_0.xml
│ ├── Leiningen__org_apache_directory_studio_org_apache_commons_io_2_4.xml
│ ├── Leiningen__org_clojure_clojure_1_9_0_alpha16.xml
│ ├── Leiningen__org_clojure_core_specs_alpha_0_1_10.xml
│ ├── Leiningen__org_clojure_spec_alpha_0_1_94.xml
│ ├── Leiningen__org_clojure_tools_namespace_0_2_11.xml
│ ├── Leiningen__org_clojure_tools_nrepl_0_2_11.xml
│ ├── Leiningen__org_eclipse_jetty_jetty_http_9_3_8_v20160314.xml
│ ├── Leiningen__org_eclipse_jetty_jetty_io_9_3_8_v20160314.xml
│ ├── Leiningen__org_eclipse_jetty_jetty_security_9_3_8_v20160314.xml
│ ├── Leiningen__org_eclipse_jetty_jetty_server_9_3_8_v20160314.xml
│ ├── Leiningen__org_eclipse_jetty_jetty_servlet_9_3_8_v20160314.xml
│ ├── Leiningen__org_eclipse_jetty_jetty_util_9_3_8_v20160314.xml
│ ├── Leiningen__org_jsoup_jsoup_1_8_3.xml
│ └── Leiningen__org_w3c_css_sac_1_3.xml
├── markdown-navigator.xml
├── markdown-navigator
│ └── profiles_settings.xml
├── misc.xml
├── modules.xml
├── vcs.xml
└── workspace.xml
├── CHANGELOG.md
├── LICENSE
├── README.md
├── dev
├── config_gen.clj
└── user.clj
├── doc
└── intro.md
├── functional-vaadin.iml
├── project.clj
├── scripts
├── build
└── deploy
├── src
└── functional_vaadin
│ ├── actions.clj
│ ├── build_support.clj
│ ├── config.clj
│ ├── config_table.clj
│ ├── core.clj
│ ├── data_binding.clj
│ ├── event_handling.clj
│ ├── examples
│ ├── Sampler.clj
│ └── run.clj
│ ├── naming.clj
│ ├── rx
│ ├── observers.clj
│ └── operators.clj
│ ├── thread_vars.clj
│ ├── ui
│ └── LoginForm.clj
│ ├── utils.clj
│ └── validation.clj
└── test
└── functional_vaadin
├── actions_test.clj
├── build_support_test.clj
├── config_test.clj
├── core_test.clj
├── data_binding_test.clj
├── event_handling_test.clj
├── rx
├── observers_test.clj
└── operators_test.clj
├── ui
├── TestUI.clj
└── test_ui_def.clj
└── utils_test.clj
/.gitignore:
--------------------------------------------------------------------------------
1 | /target
2 | /classes
3 | /checkouts
4 | /builds
5 | pom.xml
6 | pom.xml.asc
7 | *.jar
8 | *.class
9 | /.lein-*
10 | /.nrepl-port
11 | .hgignore
12 | .hg/
13 | replstate.xml
14 | notes.txt
--------------------------------------------------------------------------------
/.idea/.name:
--------------------------------------------------------------------------------
1 | functional-vaadin
--------------------------------------------------------------------------------
/.idea/codeStyleSettings.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
17 |
18 |
19 |
--------------------------------------------------------------------------------
/.idea/compiler.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
--------------------------------------------------------------------------------
/.idea/copyright/profiles_settings.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
--------------------------------------------------------------------------------
/.idea/encodings.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
--------------------------------------------------------------------------------
/.idea/inspectionProfiles/Project_Default.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/inspectionProfiles/profiles_settings.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
--------------------------------------------------------------------------------
/.idea/leiningen.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__clojure_complete_0_2_4.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__com_vaadin_external_flute_flute_1_3_0_gg2.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__com_vaadin_vaadin_client_compiled_7_7_9.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__com_vaadin_vaadin_sass_compiler_0_9_13.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__com_vaadin_vaadin_server_7_7_9.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__com_vaadin_vaadin_shared_7_7_9.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__com_vaadin_vaadin_themes_7_7_9.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__commons_io_2_4.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__io_reactivex_rxclojure_1_0_0.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__io_reactivex_rxjava_1_0_1.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__javax_servlet_javax_servlet_api_3_1_0.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_apache_directory_studio_org_apache_commons_io_2_4.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_clojure_clojure_1_9_0_alpha16.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_clojure_core_specs_alpha_0_1_10.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_clojure_spec_alpha_0_1_94.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_clojure_tools_namespace_0_2_11.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_clojure_tools_nrepl_0_2_11.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_eclipse_jetty_jetty_http_9_3_8_v20160314.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_eclipse_jetty_jetty_io_9_3_8_v20160314.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_eclipse_jetty_jetty_security_9_3_8_v20160314.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_eclipse_jetty_jetty_server_9_3_8_v20160314.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_eclipse_jetty_jetty_servlet_9_3_8_v20160314.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_eclipse_jetty_jetty_util_9_3_8_v20160314.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_jsoup_jsoup_1_8_3.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/libraries/Leiningen__org_w3c_css_sac_1_3.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
--------------------------------------------------------------------------------
/.idea/markdown-navigator.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
--------------------------------------------------------------------------------
/.idea/markdown-navigator/profiles_settings.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
--------------------------------------------------------------------------------
/.idea/misc.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
--------------------------------------------------------------------------------
/.idea/modules.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
--------------------------------------------------------------------------------
/.idea/vcs.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Change Log
2 |
3 | ## [0.1.0-SNAPSHOT] - 2016-05-08
4 |
5 | ### Added
6 | - First pre-release SNAPSHOT. Missing field validation, bind syntax needs work
7 | - Initial set of builder
8 |
9 | ## [0.1.0] - 2016-05-14
10 | - Initial release
11 |
12 | ### Added
13 | - Validation, including FunctionalValidator type
14 | - Builders for table, table columns
15 | - Shortcut actions for Panel/Window
16 | - RxClojure integration
17 | - Better documentation
18 |
19 | ### Missing
20 | - ColorPicker and Calendar components
21 | - Tree and TreeTable components
22 | - Full Action definition and handling
23 | - Various event observers: Upload, Component click, etc.
24 |
25 | ## [0.1.1] - 2016-05-15
26 |
27 | ### Added
28 | - Better documentation, better jar constructions
29 | - Actions on Panel and Window
30 |
31 | ## [0.2.0]
32 |
33 | Do not use - deploy bug
34 |
35 | ## [0.2.1]
36 |
37 | ### Added
38 | - Added Tree, TreeTable, Accordion, Upload, LoginForm and shortcutActions builders
39 | - FunctionalValidator
40 | - Added Container$Hierarchical builder
41 | - Sampler app updated
42 | - Upgraded to Vaadin 7.7.3
43 |
44 | ### Changed
45 | - Bug fixes!
46 | - Improved documentation
47 | - Internal refactoring, mostly using clojure.spec for parsing and error reporting
48 |
49 | ### TO DO
50 | - Builders: calendar, popupview, browser-frame, audio, video, color picker, flash, notification, grid
51 | - Better error reporting (using clojure.spec)
52 | - Generated table columns, table click actions
53 |
54 | ## [0.2.2]
55 |
56 | ### Changed
57 | - More bug fixes
58 | - Documentation updates
59 | - Upgraded to clojure-1.9.0-alpha16
60 |
61 | ## [0.3.0]
62 |
63 | ### Changed
64 | - Upgraded to Vaadin 7.7.9
65 | - Sampler updated to show new features
66 |
67 | ### Added
68 | - Generated table columns. table-column can now take a generation function
69 | - Table click actions
70 | - Table cell style generation
71 |
72 |
73 |
74 |
75 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Eclipse Public License - v 1.0
2 |
3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC
4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM
5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.
6 |
7 | 1. DEFINITIONS
8 |
9 | "Contribution" means:
10 |
11 | a) in the case of the initial Contributor, the initial code and documentation
12 | distributed under this Agreement, and
13 | b) in the case of each subsequent Contributor:
14 | i) changes to the Program, and
15 | ii) additions to the Program;
16 |
17 | where such changes and/or additions to the Program originate from and are
18 | distributed by that particular Contributor. A Contribution 'originates'
19 | from a Contributor if it was added to the Program by such Contributor
20 | itself or anyone acting on such Contributor's behalf. Contributions do not
21 | include additions to the Program which: (i) are separate modules of
22 | software distributed in conjunction with the Program under their own
23 | license agreement, and (ii) are not derivative works of the Program.
24 |
25 | "Contributor" means any person or entity that distributes the Program.
26 |
27 | "Licensed Patents" mean patent claims licensable by a Contributor which are
28 | necessarily infringed by the use or sale of its Contribution alone or when
29 | combined with the Program.
30 |
31 | "Program" means the Contributions distributed in accordance with this
32 | Agreement.
33 |
34 | "Recipient" means anyone who receives the Program under this Agreement,
35 | including all Contributors.
36 |
37 | 2. GRANT OF RIGHTS
38 | a) Subject to the terms of this Agreement, each Contributor hereby grants
39 | Recipient a non-exclusive, worldwide, royalty-free copyright license to
40 | reproduce, prepare derivative works of, publicly display, publicly
41 | perform, distribute and sublicense the Contribution of such Contributor,
42 | if any, and such derivative works, in source code and object code form.
43 | b) Subject to the terms of this Agreement, each Contributor hereby grants
44 | Recipient a non-exclusive, worldwide, royalty-free patent license under
45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise
46 | transfer the Contribution of such Contributor, if any, in source code and
47 | object code form. This patent license shall apply to the combination of
48 | the Contribution and the Program if, at the time the Contribution is
49 | added by the Contributor, such addition of the Contribution causes such
50 | combination to be covered by the Licensed Patents. The patent license
51 | shall not apply to any other combinations which include the Contribution.
52 | No hardware per se is licensed hereunder.
53 | c) Recipient understands that although each Contributor grants the licenses
54 | to its Contributions set forth herein, no assurances are provided by any
55 | Contributor that the Program does not infringe the patent or other
56 | intellectual property rights of any other entity. Each Contributor
57 | disclaims any liability to Recipient for claims brought by any other
58 | entity based on infringement of intellectual property rights or
59 | otherwise. As a condition to exercising the rights and licenses granted
60 | hereunder, each Recipient hereby assumes sole responsibility to secure
61 | any other intellectual property rights needed, if any. For example, if a
62 | third party patent license is required to allow Recipient to distribute
63 | the Program, it is Recipient's responsibility to acquire that license
64 | before distributing the Program.
65 | d) Each Contributor represents that to its knowledge it has sufficient
66 | copyright rights in its Contribution, if any, to grant the copyright
67 | license set forth in this Agreement.
68 |
69 | 3. REQUIREMENTS
70 |
71 | A Contributor may choose to distribute the Program in object code form under
72 | its own license agreement, provided that:
73 |
74 | a) it complies with the terms and conditions of this Agreement; and
75 | b) its license agreement:
76 | i) effectively disclaims on behalf of all Contributors all warranties
77 | and conditions, express and implied, including warranties or
78 | conditions of title and non-infringement, and implied warranties or
79 | conditions of merchantability and fitness for a particular purpose;
80 | ii) effectively excludes on behalf of all Contributors all liability for
81 | damages, including direct, indirect, special, incidental and
82 | consequential damages, such as lost profits;
83 | iii) states that any provisions which differ from this Agreement are
84 | offered by that Contributor alone and not by any other party; and
85 | iv) states that source code for the Program is available from such
86 | Contributor, and informs licensees how to obtain it in a reasonable
87 | manner on or through a medium customarily used for software exchange.
88 |
89 | When the Program is made available in source code form:
90 |
91 | a) it must be made available under this Agreement; and
92 | b) a copy of this Agreement must be included with each copy of the Program.
93 | Contributors may not remove or alter any copyright notices contained
94 | within the Program.
95 |
96 | Each Contributor must identify itself as the originator of its Contribution,
97 | if
98 | any, in a manner that reasonably allows subsequent Recipients to identify the
99 | originator of the Contribution.
100 |
101 | 4. COMMERCIAL DISTRIBUTION
102 |
103 | Commercial distributors of software may accept certain responsibilities with
104 | respect to end users, business partners and the like. While this license is
105 | intended to facilitate the commercial use of the Program, the Contributor who
106 | includes the Program in a commercial product offering should do so in a manner
107 | which does not create potential liability for other Contributors. Therefore,
108 | if a Contributor includes the Program in a commercial product offering, such
109 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify
110 | every other Contributor ("Indemnified Contributor") against any losses,
111 | damages and costs (collectively "Losses") arising from claims, lawsuits and
112 | other legal actions brought by a third party against the Indemnified
113 | Contributor to the extent caused by the acts or omissions of such Commercial
114 | Contributor in connection with its distribution of the Program in a commercial
115 | product offering. The obligations in this section do not apply to any claims
116 | or Losses relating to any actual or alleged intellectual property
117 | infringement. In order to qualify, an Indemnified Contributor must:
118 | a) promptly notify the Commercial Contributor in writing of such claim, and
119 | b) allow the Commercial Contributor to control, and cooperate with the
120 | Commercial Contributor in, the defense and any related settlement
121 | negotiations. The Indemnified Contributor may participate in any such claim at
122 | its own expense.
123 |
124 | For example, a Contributor might include the Program in a commercial product
125 | offering, Product X. That Contributor is then a Commercial Contributor. If
126 | that Commercial Contributor then makes performance claims, or offers
127 | warranties related to Product X, those performance claims and warranties are
128 | such Commercial Contributor's responsibility alone. Under this section, the
129 | Commercial Contributor would have to defend claims against the other
130 | Contributors related to those performance claims and warranties, and if a
131 | court requires any other Contributor to pay any damages as a result, the
132 | Commercial Contributor must pay those damages.
133 |
134 | 5. NO WARRANTY
135 |
136 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN
137 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR
138 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE,
139 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each
140 | Recipient is solely responsible for determining the appropriateness of using
141 | and distributing the Program and assumes all risks associated with its
142 | exercise of rights under this Agreement , including but not limited to the
143 | risks and costs of program errors, compliance with applicable laws, damage to
144 | or loss of data, programs or equipment, and unavailability or interruption of
145 | operations.
146 |
147 | 6. DISCLAIMER OF LIABILITY
148 |
149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY
150 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL,
151 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION
152 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
153 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
154 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE
155 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY
156 | OF SUCH DAMAGES.
157 |
158 | 7. GENERAL
159 |
160 | If any provision of this Agreement is invalid or unenforceable under
161 | applicable law, it shall not affect the validity or enforceability of the
162 | remainder of the terms of this Agreement, and without further action by the
163 | parties hereto, such provision shall be reformed to the minimum extent
164 | necessary to make such provision valid and enforceable.
165 |
166 | If Recipient institutes patent litigation against any entity (including a
167 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself
168 | (excluding combinations of the Program with other software or hardware)
169 | infringes such Recipient's patent(s), then such Recipient's rights granted
170 | under Section 2(b) shall terminate as of the date such litigation is filed.
171 |
172 | All Recipient's rights under this Agreement shall terminate if it fails to
173 | comply with any of the material terms or conditions of this Agreement and does
174 | not cure such failure in a reasonable period of time after becoming aware of
175 | such noncompliance. If all Recipient's rights under this Agreement terminate,
176 | Recipient agrees to cease use and distribution of the Program as soon as
177 | reasonably practicable. However, Recipient's obligations under this Agreement
178 | and any licenses granted by Recipient relating to the Program shall continue
179 | and survive.
180 |
181 | Everyone is permitted to copy and distribute copies of this Agreement, but in
182 | order to avoid inconsistency the Agreement is copyrighted and may only be
183 | modified in the following manner. The Agreement Steward reserves the right to
184 | publish new versions (including revisions) of this Agreement from time to
185 | time. No one other than the Agreement Steward has the right to modify this
186 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The
187 | Eclipse Foundation may assign the responsibility to serve as the Agreement
188 | Steward to a suitable separate entity. Each new version of the Agreement will
189 | be given a distinguishing version number. The Program (including
190 | Contributions) may always be distributed subject to the version of the
191 | Agreement under which it was received. In addition, after a new version of the
192 | Agreement is published, Contributor may elect to distribute the Program
193 | (including its Contributions) under the new version. Except as expressly
194 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or
195 | licenses to the intellectual property of any Contributor under this Agreement,
196 | whether expressly, by implication, estoppel or otherwise. All rights in the
197 | Program not expressly granted under this Agreement are reserved.
198 |
199 | This Agreement is governed by the laws of the State of New York and the
200 | intellectual property laws of the United States of America. No party to this
201 | Agreement will bring a legal action under this Agreement more than one year
202 | after the cause of action arose. Each party waives its rights to a jury trial in
203 | any resulting litigation.
204 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # functional-vaadin
2 |
3 | A functional (Clojure) interface to the Vaadin Web UI Framework.
4 |
5 | Using Vaadin from Clojure is generally straightforward, but involves the same kind of repetion as it does from straight
6 | Java - endless .setXXX calls, intermediate vars to hold sub structure, and various minor inconveniences in setting
7 | parameters (e.g. the inability to define expansion ratios on contained objects themselves). It would also be nice to
8 | have a functional way of connecting data to the UI.
9 |
10 | This lib is designed to fix these issues. It offers
11 |
12 | - a purely declarative UI DSL, homoiconic in the same way that Clojure itself is
13 | - a component naming mechanism that removes the need for variables to refer to components, available at both
14 | construction and run time.
15 | - a simpler event handing mechanism, along with integration with RxClosure
16 | - conversion functions to interface Clojures immutable data structures with Vaadin data binding objects
17 |
18 | ## Latest Release
19 |
20 | 
21 |
22 | ## Install
23 | Add the following to you project.clj file:
24 |
25 | [com.prajaninc/functional-vaadin "0.1.1"]
26 |
27 | You will also need to add dependencies for your choosen Vaadin libraries e.g.
28 |
29 | [com.vaadin/vaadin-server "7.6.5"]
30 | [com.vaadin/vaadin-client-compiled "7.6.5"]
31 | [com.vaadin/vaadin-themes "7.6.5"]
32 |
33 |
34 | ## Usage
35 | Require the namespaces you need:
36 |
37 | Primary namespace, containing all the builder functions:
38 |
39 | (require [functional-vaadin.core :refer :all])
40 |
41 | RxClojure integrations are in:
42 |
43 | (require [functional-vaadin.rx.observers :as obs]
44 | [functional-vaadin.rx.operators :as ops])
45 |
46 | ## Documentation
47 | Guides and documentation are available on the [project wiki](https://github.com/wizardpb/functional-vaadin/wiki)
48 |
49 | API specifications are [here](http://prajnainc.com/functional-vaadin/doc/)
50 |
51 | ## Demos and Examples
52 |
53 | There is a simple Sampler application included in the repo. A more complete one is an implementation
54 | of ToDoMVC [here](https://github.com/wizardpb/todo)
55 |
56 | ## License
57 |
58 | Copyright © 2016 Prajna Inc, all rights reserved
59 |
60 | Distributed under the Eclipse Public License either version 1.0 or any later version.
61 |
--------------------------------------------------------------------------------
/dev/config_gen.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns config-gen
9 | "Development-time tools to automatically generate a table of option setters for a given set of Vaadin classes"
10 | (:require [clojure.string :as str])
11 | (:use [clojure.set]
12 | [clojure.java.io]
13 | [clojure.test])
14 | (:import (com.vaadin.ui
15 | Label Embedded Link MenuBar Upload Button Calendar GridLayout Accordion
16 | TabSheet VerticalSplitPanel HorizontalSplitPanel Slider TextField TextArea PasswordField CheckBox
17 | RichTextArea InlineDateField PopupDateField Table ComboBox TwinColSelect NativeSelect
18 | ListSelect OptionGroup Tree TreeTable Panel VerticalLayout HorizontalLayout FormLayout ProgressBar Window LoginForm)
19 | ))
20 |
21 | (def configurable-classes
22 | [
23 | Label
24 | Embedded
25 | Link
26 | MenuBar
27 | Upload
28 | Button
29 | Calendar
30 | GridLayout
31 | Panel
32 | Window
33 | VerticalLayout
34 | HorizontalLayout
35 | FormLayout
36 | TabSheet
37 | Accordion
38 | VerticalSplitPanel
39 | HorizontalSplitPanel
40 | Slider
41 | TextField
42 | TextArea
43 | PasswordField
44 | ProgressBar
45 | CheckBox
46 | RichTextArea
47 | InlineDateField
48 | PopupDateField
49 | Table
50 | ComboBox
51 | TwinColSelect
52 | NativeSelect
53 | ListSelect
54 | OptionGroup
55 | Tree
56 | TreeTable
57 | LoginForm
58 | ])
59 |
60 | (defn format-config-classes []
61 | (last
62 | (reduce #(let [old-str (last %1)
63 | line-count (first %1)
64 | new-str (if (> (quot (+ 1 (count %2) (count old-str)) 120) line-count)
65 | (str old-str "\n " %2 " ")
66 | (str old-str %2 " "))]
67 | [(quot (count new-str) 120) new-str])
68 | [0 "com.vaadin.ui "]
69 | (map #(.getSimpleName %1) configurable-classes)))
70 | )
71 |
72 | (def preamble
73 | (str
74 | "(ns functional-vaadin.config-table
75 | \"This is auto-generated by the functions in config-gen
76 | DO NOT EDIT\"
77 | (:import
78 | ("
79 | (format-config-classes)
80 | "
81 | )))
82 |
83 | (def config-table
84 | {\n"))
85 |
86 | (def postamble "})")
87 |
88 | (defn extract-setters
89 | "Extract all setters of the form 'setXXX' from the configurable classes list. Return a set of tuples
90 | {:name XXX :argcount N}. Acc is a transient set"
91 | [acc cls]
92 | (let [setters (filter #(= (subs (:name %1) 0 3) "set")
93 | (map (fn [m] {:name (.getName m) :argcount (.getParameterCount m)})
94 | (.getMethods cls)))]
95 | (doseq [s setters]
96 | (conj! acc s)))
97 | acc)
98 |
99 |
100 | (defn gen-config-table []
101 | (let [opt-list
102 | (sort #(compare (:name %1) (:name %2))
103 | (persistent!
104 | (reduce extract-setters (transient #{}) configurable-classes)))]
105 | (with-open [f (writer "src/functional_vaadin/config_table.clj")]
106 | (.write f preamble)
107 | (doseq [opt opt-list]
108 | (let [arg-count (:argcount opt)
109 | arg-string (str/join " "
110 | (map #(str "arg" %1) (range 0 arg-count)))
111 | opt-name (:name opt)]
112 | (.write f
113 | (str " [:" opt-name " " arg-count "] (fn [obj " arg-string "] (."
114 | opt-name
115 | " obj " arg-string "))\n"))))
116 | (.write f postamble))))
117 |
118 | (defn all-setters [cls]
119 | (sort #(compare (first %1) (first %2)) (filter #(= (subs (first %1) 0 3) "set")
120 | (map (fn [m] [(.getName m) (.getParameterCount m)])
121 | (.getMethods cls)))))
122 |
123 | (defn has-dup-setters? [cls]
124 | (let [setters (all-setters cls)]
125 | (not= (count setters) (count (set setters)))))
126 |
127 | (defn find-dups [cls]
128 | (let [s (all-setters cls)]
129 | (letfn [(update-count
130 | [acc s]
131 | (update acc s #(if %1 (inc %1) 1)))]
132 | (filter #(> (last %1) 1) (reduce update-count {} (all-setters cls))))))
--------------------------------------------------------------------------------
/dev/user.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns user
9 | (:require [clojure.string :as str]
10 | [clojure.pprint :as pp]
11 | [clojure.spec.alpha :as s]
12 | [functional-vaadin.core :refer :all]
13 | [functional-vaadin.event-handling :refer :all]
14 | [functional-vaadin.build-support :refer :all]
15 | [functional-vaadin.rx.observers :as obs]
16 | [functional-vaadin.rx.operators :as ops]
17 | [functional-vaadin.utils :as u]
18 | [functional-vaadin.examples.run :refer [run-jetty]]
19 | [rx.lang.clojure.core :as rx]
20 | [clojure.tools.namespace.repl :refer [refresh]])
21 | (:use clojure.test config-gen
22 | functional-vaadin.ui.test-ui-def
23 | )
24 | (:import (java.io File)
25 | (org.apache.commons.io FileUtils)
26 | (com.vaadin.ui UI)))
27 |
28 | (def test-dir "test/")
29 |
30 | (defn test-ns-sym [fname]
31 | (symbol (-> fname
32 | (str/replace #"\.clj$" "")
33 | (str/replace #"test/" "")
34 | (str/replace #"/" ".")
35 | (str/replace #"_" "-"))))
36 |
37 | (defn file-paths [^String base-dir]
38 | (map #(.getPath %1)
39 | (FileUtils/listFiles
40 | ^File (File. base-dir)
41 | #^"[Ljava.lang.String;" (into-array ["clj"])
42 | true)))
43 |
44 | (defn run-my-tests []
45 | (let [test-files (file-paths test-dir)]
46 | (doseq [fname test-files]
47 | (load-file fname))
48 | (apply run-tests (map test-ns-sym test-files))))
49 |
50 |
51 | (comment
52 | (gen-config-table)
53 | (do (refresh) (run-my-tests))
54 | (def server (run-jetty "functional_vaadin.examples.Sampler" true))
55 | (do (.stop server) (def server (run-jetty "functional_vaadin.examples.Sampler" true)))
56 | (def server (run-jetty "functional_vaadin.ui.TestUI" true))
57 | (.stop server) (def server (run-jetty "functional_vaadin.ui.TestUI" true))
58 | (def server (run-jetty "functional_vaadin.examples.todo.ToDo" true))
59 | (do (.stop server) (def server (run-jetty "functional_vaadin.examples.todo.ToDo" true)))
60 | )
61 |
62 |
--------------------------------------------------------------------------------
/doc/intro.md:
--------------------------------------------------------------------------------
1 | # Introduction to functional-vaadin
2 |
3 | Full documentation is available on the [project wiki](https://github.com/wizardpb/functional-vaadin/wiki)
4 |
--------------------------------------------------------------------------------
/functional-vaadin.iml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
1 | (defproject com.prajnainc/functional-vaadin "0.3.0-snapshot"
2 | :description "A functional interface to Vaadin"
3 | :url "https://github.com/wizardpb/functional-vaadin"
4 | :license {:name "Eclipse Public License"
5 | :url "http://www.eclipse.org/legal/epl-v10.html"}
6 | :plugins [[lein-codox "0.9.5"]
7 | [lein-pprint "1.1.1"]]
8 | :dependencies [[org.clojure/clojure "1.9.0-alpha16"]
9 | [io.reactivex/rxclojure "1.0.0"]]
10 | :codox {:namespaces [functional-vaadin.core
11 | functional-vaadin.conversion
12 | functional-vaadin.validation
13 | functional-vaadin.rx.observers
14 | functional-vaadin.rx.operators]}
15 | :profiles {:provided {:dependencies [[com.vaadin/vaadin-server "7.7.9"]
16 | [com.vaadin/vaadin-client-compiled "7.7.9"]
17 | [com.vaadin/vaadin-themes "7.7.9"]
18 | [org.eclipse.jetty/jetty-server "9.3.8.v20160314"]
19 | [org.eclipse.jetty/jetty-servlet "9.3.8.v20160314"]
20 | [javax.servlet/javax.servlet-api "3.1.0"]]}
21 | :dev {:aot [functional-vaadin.ui.LoginForm
22 | functional-vaadin.ui.TestUI
23 | functional-vaadin.examples.Sampler
24 | functional-vaadin.examples.run]
25 | :main functional-vaadin.examples.run
26 | :source-paths ["src" "dev"]
27 | :dependencies [[org.apache.directory.studio/org.apache.commons.io "2.4"]
28 | [org.clojure/tools.nrepl "0.2.11"]
29 | [org.clojure/tools.namespace "0.2.11"]
30 | ]
31 | }
32 | :jar {:aot [functional-vaadin.ui.LoginForm]
33 | ;:dependencies [[com.vaadin/vaadin-server "7.7.3"]
34 | ; [com.vaadin/vaadin-client-compiled "7.7.3"]
35 | ; [com.vaadin/vaadin-themes "7.7.3"]
36 | ; [org.eclipse.jetty/jetty-server "9.3.8.v20160314"]
37 | ; [org.eclipse.jetty/jetty-servlet "9.3.8.v20160314"]
38 | ; [javax.servlet/javax.servlet-api "3.1.0"]]
39 | }
40 | :uberjar {:aot [functional-vaadin.ui.LoginForm functional-vaadin.examples.Sampler functional-vaadin.examples.run]
41 | :main functional-vaadin.examples.run
42 | :dependencies [[com.vaadin/vaadin-server "7.7.3"]
43 | [com.vaadin/vaadin-client-compiled "7.7.3"]
44 | [com.vaadin/vaadin-themes "7.7.3"]
45 | [org.eclipse.jetty/jetty-server "9.3.8.v20160314"]
46 | [org.eclipse.jetty/jetty-servlet "9.3.8.v20160314"]
47 | [javax.servlet/javax.servlet-api "3.1.0"]]
48 | }
49 | }
50 | )
51 |
--------------------------------------------------------------------------------
/scripts/build:
--------------------------------------------------------------------------------
1 | build_dir="builds/${1:-default}"
2 | lein uberjar
3 | lein codox
4 | rm -rf $build_dir
5 | mv target $build_dir
6 | lein with-profile +provided,+jar jar
7 | lein pom
8 |
9 |
--------------------------------------------------------------------------------
/scripts/deploy:
--------------------------------------------------------------------------------
1 | lein with-profile +provided,+jar deploy clojars
2 |
--------------------------------------------------------------------------------
/src/functional_vaadin/actions.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 | (ns functional-vaadin.actions
8 | "Useful public functions for creating and manipulatinig Actions, It provides a new type ActionHandler, implementing Action$Handler. This
9 | allows for the customization of action selection and handling by providing two functions, a select function and a handler function, along
10 | with a list of Actions to choose from."
11 | (:require [clojure.spec.alpha :as s])
12 | (:use [functional-vaadin.utils])
13 | (:import (com.vaadin.event Action$Listener ShortcutAction Action$Handler Action)))
14 |
15 | (defn ->FunctionAction
16 | "Usage: (->FunctionAction caption icon? action-fn)
17 |
18 | Create an Action that executes action-fn when it is activated. This can be added to any Component that implements
19 | com.vaadin.Action.Notiifer, and also supplied as an Action to functional_vaadin.action.ActionHandler.
20 |
21 | The action-fn is called as (action-fn action sender target)"
22 | ([caption icon action-fn]
23 | (proxy [Action Action$Listener] [caption icon]
24 | (handleAction [sender target] (action-fn this sender target))))
25 | ([caption action-fn]
26 | (->FunctionAction caption nil action-fn))
27 | )
28 |
29 | (defn ->ShortcutAction
30 | "Usage: (->ShortcutAction caption keycode action-fn modifiers?)
31 | (->ShortcutAction [caption resource] keycode action-fn modifiers?)
32 |
33 |
34 | Create a ShortcutAction that executes action-fn when fired. The action function is called as
35 | (action-fn action sender target)"
36 | ([ident keycode action-fn modifiers]
37 | (cond
38 | (instance? String ident)
39 | (proxy [ShortcutAction Action$Listener] [ident (int keycode) (int-array modifiers)]
40 | (handleAction [sender target] (action-fn this sender target)))
41 | (and (vector? ident) (= 2 (count ident)))
42 | (proxy [ShortcutAction Action$Listener] [(first ident) (second ident) (int keycode) (int-array modifiers)]
43 | (handleAction [sender target] (action-fn this sender target)))
44 | :else (bad-argument "Incorrect name: " ident ". Shortcut name must be a String or Vector of caption and icon")
45 | ))
46 | ([ident keycode a-fn] (->ShortcutAction ident keycode a-fn []))
47 | )
48 |
49 | (deftype ActionHandler [select-fn handle-fn actions]
50 | Action$Handler
51 | (getActions [this target sender]
52 | (into-array (select-fn target sender actions)))
53 | (handleAction [this action sender target]
54 | (handle-fn action sender target)
55 | )
56 | )
57 |
58 | (defn dispatch-listener
59 | "A convenience handler function for ActionHandler that displatches an Action as an Action$Listener. Actions held in this
60 | ActionHandler must therefore be Action$Listeners (->FunctionalAction) creates such actions"
61 | [action sender target]
62 | (.handleAction action sender target))
63 |
64 | (defn all-actions
65 | "A convenience action selection function for an ActionHandler. Simply returns all available actions"
66 | [target sender actions]
67 | actions)
68 |
69 |
70 |
71 |
72 |
--------------------------------------------------------------------------------
/src/functional_vaadin/build_support.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.build-support
9 | "Functions useful in implementing all the builder functions in core"
10 | (:require [functional-vaadin.thread-vars :refer :all]
11 | [functional-vaadin.config :refer :all]
12 | [functional-vaadin.data-binding :refer :all]
13 | [functional-vaadin.utils :refer :all]
14 | [clojure.set :as set]
15 | [clojure.spec.alpha :as s])
16 | (:import (com.vaadin.ui
17 | Panel AbstractOrderedLayout GridLayout AbstractSplitPanel AbstractComponentContainer Table Alignment Table$Align FormLayout ComponentContainer MenuBar MenuBar$Command MenuBar$MenuItem Window Component Table$ColumnGenerator)
18 | (java.util Map Collection)
19 | (java.lang.reflect Constructor)
20 | (clojure.lang Keyword)
21 | (com.vaadin.server Resource)
22 | ))
23 |
24 | ;; A MenuBar.Command that allows functions as Menu Items
25 |
26 | (defrecord FunctionCommand [cmd-fn]
27 | MenuBar$Command
28 | (^void menuSelected [this ^MenuBar$MenuItem item] (cmd-fn item)))
29 |
30 | ;; An interface for defining MenuItems
31 |
32 | (defprotocol IMenuItemSpec
33 | (hasChildren? [this])
34 | (addFrom [this mbi])
35 | (getChildren [this])
36 | )
37 |
38 | (deftype MenuItemSpec [name resource content]
39 | IMenuItemSpec
40 | (hasChildren? [this] (instance? Collection content))
41 | (addFrom [this mbi]
42 | {:pre [(or (nil? content) (fn? content))]}
43 | (if (nil? content)
44 | (.addSeparator mbi)
45 | (.addItem mbi name resource (->FunctionCommand content))))
46 | (getChildren [this] content)
47 | )
48 |
49 | (defn- translate-column-options [propertyId column-config]
50 | ; translate option :XXX to :columnXXX. This gets further translated to :setColumnXXX by (configure)
51 | ; Also add in the propertyId as the first argument
52 | (reduce (fn [tconfig [opt-key opt-arg]]
53 | (assoc tconfig
54 | (keyword (str "column" (capitalize (name opt-key))))
55 | [propertyId opt-arg]))
56 | {}
57 | column-config))
58 |
59 | (defprotocol ITableColumn
60 | (addToTable [this table]))
61 |
62 | (deftype TableColumn [propertyId options]
63 | ITableColumn
64 | (addToTable [this table]
65 | (let [[{:keys [type defaultValue]} column-config] (extract-keys options #{:type :defaultValue})]
66 | (.addContainerProperty table propertyId type defaultValue)
67 | (->> column-config
68 | (translate-column-options propertyId)
69 | (configure table)))))
70 |
71 | (deftype GeneratedTableColumn [propertyId config gen_fn]
72 | ITableColumn
73 | (addToTable [this table]
74 | (.addGeneratedColumn table propertyId
75 | (reify
76 | Table$ColumnGenerator
77 | (generateCell [this t item col] (gen_fn t item col))))
78 | (->> config
79 | (translate-column-options propertyId)
80 | (configure table))))
81 |
82 | ;; Argument parsing
83 |
84 | (s/def ::menu-items (s/* #(instance? IMenuItemSpec %)))
85 | (s/def ::menu-item-args
86 | (s/cat :name string?
87 | :icon_resource (s/? #(instance? Resource %))
88 | :children (s/alt :item_fn fn? :sub_items (s/+ #(instance? MenuItemSpec %)))))
89 |
90 | (s/def ::component-args
91 | (s/cat
92 | :initial-args (s/* #(not (instance? Map %)))
93 | :config (s/? #(instance? Map %))
94 | :children (s/* #(or
95 | (instance? Component %)
96 | (instance? TableColumn %)
97 | (instance? GeneratedTableColumn %)
98 | (instance? MenuItemSpec %)))))
99 |
100 | ;; Widget creation
101 |
102 | (defn- match-arg
103 | "Return the argument if it's type matches ctor-type. Matching is done using Java assignability. Since Clojure uses
104 | integer Long types exclusively, Integer types match a Long argument, and it is converted to a raw int. Return nil
105 | if there is no match"
106 | [^Class ctor-type arg]
107 | (cond
108 | (and (= ctor-type Integer/TYPE) (= (class arg) Long)) (int arg)
109 | (.isAssignableFrom ctor-type (class arg)) arg
110 | :else nil))
111 |
112 | (defn- match-args
113 | " Match possible (non-empty) arguments with ctor argument types. Return matched (possibly converted) arguments"
114 | [ctor-param-types args]
115 | (if (and (> (count args) 0) (= (count ctor-param-types) (count args)))
116 | (let [conv-args (map match-arg ctor-param-types args)] (if (every? identity conv-args) conv-args)))
117 | )
118 |
119 | (defn- null-ctor-for [cls]
120 | {:ctor (.getConstructor cls (make-array Class 0)) :ctor-args '()})
121 |
122 | (defn- buildable-childen?
123 | "Can all these args be considered vald children of a widget? True if they are all Components, MenuItemSpecs or TableColumn"
124 | [args]
125 | (or
126 | (every? #(instance? Component %) args)
127 | (every? #(instance? MenuItemSpec %) args)
128 | (every? #(instance? TableColumn %) args)))
129 |
130 | (defn- find-constructor
131 | "Find a constructor for the given class and arguments, matching argument types against the arguments
132 | Longer matches take precendent, and assignability determines an argument match.
133 |
134 | If no arguments are passed, just return the no-arg constructor.
135 |
136 | If no constructor is found, but all arguments are valid children, return the no-arg constructor so they get interpreted as children
137 | by the widget creator"
138 |
139 | [cls args]
140 | (letfn [(match-ctor [ctor]
141 | (if-let [conv-args (match-args (seq (.getParameterTypes ctor)) (take (.getParameterCount ctor) args))]
142 | {:ctor ctor :ctor-args conv-args}))]
143 | (if (zero? (count args))
144 | (null-ctor-for cls)
145 | (let [ctor-list (sort #(>= (.getParameterCount %1) (.getParameterCount %2)) (seq (.getConstructors cls)))]
146 | (or
147 | (some match-ctor ctor-list)
148 | (if (buildable-childen? args) (null-ctor-for cls) nil))))))
149 |
150 | (defn- parse-builder-args
151 | "Parse builder arguments, returning a constructor, it's arguments, any unused constructor arguments,
152 | an optional config map, and any children"
153 | [cls args]
154 | (let [split-args (s/conform ::component-args args)
155 | cls-name (.getSimpleName cls)]
156 | (if (= split-args ::s/invalid)
157 | (bad-argument "Bad format building " cls-name ": " (s/explain-str ::component-args args))
158 | (let [{:keys [initial-args config]} split-args
159 | {:keys [ctor-args] :as ctor-map} (find-constructor cls initial-args)]
160 | ; If there is no config, the initial-args are a combination of children and ctor args, so split out any children
161 | ; otherwise just set any initial arguments that haven't been matched to the constructor
162 | (merge split-args ctor-map (if config
163 | {:unused-args (drop (count ctor-args) initial-args)}
164 | {:unused-args [] :children (drop (count ctor-args) initial-args)})
165 | )
166 |
167 | ))
168 | ))
169 |
170 | (defn- do-create-widget
171 | "Create Vaadin widgets from a list of arguments. The variable arguments are a list of constructor values, an optional config Map
172 | and any child widgets.
173 | "
174 | [cls args allow-children]
175 | (let [{:keys [ctor ctor-args initial-args unused-args config children]} (parse-builder-args cls args)
176 | cls-name (.getSimpleName cls)]
177 | (cond
178 | (not ctor) (bad-argument "Cannot create a " cls-name " from " initial-args)
179 | (and (not allow-children) (not-empty children)) (bad-argument cls-name " does not allow children components")
180 | (not-empty unused-args) (bad-argument "Unknown extra arguments after constructor args "
181 | (drop (count ctor-args) initial-args)))
182 |
183 | (let [obj (.newInstance ctor (object-array ctor-args))]
184 | [(if config (configure obj config) obj) (or children '())])
185 | ))
186 |
187 | (defn create-widget
188 | ([cls args allow-children] (do-create-widget cls args allow-children))
189 | ([cls args]
190 | (let [[w c] (do-create-widget cls args false)]
191 | w)))
192 |
193 | (defn create-form-content [args]
194 | (let [[arg1 arg2] args]
195 | (cond
196 | ;; Use the config to determine content. If it's there, remove it and configure the value with the rest of the config
197 | (and (instance? Map arg1) (:content arg1)) [
198 | (configure (:content arg1) (dissoc arg1 :content))
199 | (drop 1 args)]
200 | ; We have a content directly - configure it if the second argumen is a Map, otherwise that's the layout result
201 | (instance? ComponentContainer arg1) (if (instance? Map arg2)
202 | [(configure arg1 arg2) (drop 2 args)]
203 | [arg1 (drop 1 args)])
204 | ; Otherwise defaul content is a normally-created FormLayout
205 | :else (create-widget FormLayout args true))))
206 |
207 | ;; Adding content
208 |
209 | (defmulti add-children (fn [parent children] (class parent)))
210 |
211 | (defmethod add-children :default [parent children]
212 | (unsupported-op "add-children undefined!!!" (class parent)))
213 |
214 | (defn- set-children-as-content [obj children]
215 | (if (< 1 (count children))
216 | (bad-argument "You must set the content of a " (.getSimpleName (class obj)) " before adding multiple children, or provide a single child as content")
217 | (.setContent obj (if children (first children)))))
218 |
219 | (defmethod add-children Panel [panel children]
220 | (if-let [content (.getContent panel)]
221 | (when-not (zero? (count children))
222 | (add-children content children))
223 | (set-children-as-content panel children))
224 | panel)
225 |
226 | (defmethod add-children Window [window children]
227 | (if-let [content (.getContent window)]
228 | (add-children content children)
229 | (set-children-as-content window children))
230 | window)
231 |
232 | (defmethod add-children AbstractComponentContainer [parent children]
233 | (doseq [child children]
234 | (.addComponent parent child))
235 | parent)
236 |
237 | (defmethod add-children AbstractOrderedLayout [parent children]
238 | (doseq [child children]
239 | (.addComponent parent child)
240 | (do-configure parent (get-data child :parent-data)))
241 | parent)
242 |
243 | (defmethod add-children GridLayout [^GridLayout parent children]
244 | (doseq [child children]
245 | ; Extract the grid layout child options
246 | (let [[grid-config parent-config] (extract-keys (get-data child :parent-data) #{:position :span})
247 | {[x y] :position [dx dy] :span} grid-config]
248 | (condp = (set (keys grid-config))
249 | #{} (.addComponent parent child)
250 | #{:position} (.addComponent parent child x y)
251 | #{:position :span} (.addComponent parent child x y (+ x dx -1) (+ y dy -1))
252 | #{:span} (bad-argument ":span requires a :position value as well"))
253 | (do-configure parent parent-config)))
254 | parent)
255 |
256 | (defmethod add-children AbstractSplitPanel [parent children]
257 | (doseq [child children]
258 | (.addComponent parent child))
259 | parent)
260 |
261 | (defn ->MenItemSeparator []
262 | (->MenuItemSpec nil nil nil))
263 |
264 | (defn add-menu-item [mbi item]
265 | (let [sub-item (addFrom item mbi)]
266 | (if (hasChildren? item)
267 | (loop [children (getChildren item)]
268 | (when-not (empty? children)
269 | (add-menu-item sub-item (first children))
270 | (recur (rest children)))
271 | ))))
272 |
273 | (defmethod add-children MenuBar [mb mitems]
274 | {:pre [(every? #(instance? MenuItemSpec %1) mitems)]}
275 | (doseq [mitem mitems]
276 | (add-menu-item mb mitem)))
277 |
278 | ;Tables
279 |
280 | (defmethod add-children Table [table children]
281 | ; Children are configuration Maps of Table setters for that column
282 | (doseq [child children]
283 | (addToTable child table))
284 | table)
285 |
--------------------------------------------------------------------------------
/src/functional_vaadin/config.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.config
9 | "Functions for doing map-based configuration of Vaadinwidgets. See config-table namespace"
10 | (:require [clojure.string :as str]
11 | [clojure.spec.alpha :as s]
12 | [functional-vaadin.thread-vars :refer :all]
13 | [functional-vaadin.config-table :refer :all]
14 | [functional-vaadin.event-handling :refer :all]
15 | [functional-vaadin.naming :refer :all]
16 | [functional-vaadin.data-binding :refer :all]
17 | [functional-vaadin.utils :refer :all])
18 | (:import (java.util Map Collection)
19 | (clojure.lang Keyword)
20 | (com.vaadin.ui AbstractComponent AbstractOrderedLayout Alignment Table Table$CellStyleGenerator)
21 | (com.vaadin.shared.ui MarginInfo)
22 | (com.vaadin.event Action Action$Listener Action$Notifier Action$Handler Action$Container)
23 | (com.vaadin.data Validator)
24 | ))
25 |
26 | (def attribute-translation
27 | "A mapping for alternative names for configuration attribute keys"
28 | {:alignment :componentAlignment})
29 |
30 | (defn- save-for-layout-parent
31 | "Save an option for setting as an attribute on the parent. The saved value is an argument list for the attribute setter"
32 | [^AbstractComponent child opt-key opt-value]
33 | (.setData child (assoc-in (or (.getData child) {}) [:parent-data opt-key] [child opt-value])))
34 |
35 | (defn- save-for-grid-parent
36 | "Save an option for setting as an attribute on the parent. The saved value is an argument list for the attribute setter"
37 | [^AbstractComponent child opt-key opt-value]
38 | (.setData child (assoc-in (or (.getData child) {}) [:parent-data opt-key] opt-value)))
39 |
40 | (defn validate-margin [opt-val]
41 | (or (instance? Boolean opt-val)
42 | (and (instance? Collection opt-val)
43 | (<= (count opt-val) 4)
44 | (every? #{:left :right :top :bottom :vertical :horizontal} opt-val)
45 | )))
46 |
47 | (defn ^MarginInfo ->MarginInfo [opt-val]
48 | (if (instance? Boolean opt-val)
49 | (MarginInfo. ^Boolean opt-val)
50 | (MarginInfo.
51 | (boolean (some #{:top :vertical} opt-val))
52 | (boolean (some #{:right :horizontal} opt-val))
53 | (boolean (some #{:bottom :vertical} opt-val))
54 | (boolean (some #{:left :horizontal} opt-val))
55 | )
56 | ))
57 |
58 | (defn- validate-bind-args [propertyId type initialValue]
59 | (if (not-of-type propertyId [String Keyword])
60 | (bad-argument "Property Id '" propertyId "' must be a String or Keyword"))
61 | (if (not (class? type))
62 | (bad-argument "Type spec must be a Class"))
63 | (if (not (or (nil? initialValue) (.isAssignableFrom type (class initialValue))))
64 | (bad-argument "Specified initial value '" initialValue "' and type '" type "' are incompatible")))
65 |
66 | (defn- do-bind [field prop-id prop-type initVal]
67 | {:pre [(not (nil? *current-field-group*))]}
68 | (validate-bind-args prop-id prop-type initVal)
69 | (let [data-source (.getItemDataSource *current-field-group*)
70 | data-prop-ids (set (.getItemPropertyIds data-source))]
71 | (if (not (contains? data-prop-ids prop-id))
72 | (.addItemProperty data-source prop-id (->Property initVal prop-type)))
73 | (.bind *current-field-group* field prop-id)
74 | (if (nil? (.getCaption field))
75 | (.setCaption field (humanize prop-id)))
76 | field))
77 |
78 | (defn bind-field [field opt-val]
79 | (condp instance? opt-val
80 | String (do-bind field opt-val Object nil)
81 | Map (let [{:keys [propertyId type initialValue]} opt-val]
82 | (do-bind field propertyId (or type Object) initialValue))
83 | Collection (let [[propertyId type initialValue] opt-val]
84 | (do-bind field propertyId (or type Object) initialValue))))
85 |
86 | (defn add-validations
87 | "Add validators to the given fields. Validators are a single or sequence of Validator instances"
88 | [field arg]
89 | (let [validators (if (collection? arg) arg [arg])]
90 | (reduce (fn [f v] (.addValidator f v) f) field validators)))
91 |
92 | (defn- validator? [v]
93 | (instance? Validator v))
94 |
95 | (defn- check-validators [val]
96 | (if (collection? val)
97 | (every? validator? val)
98 | (validator? val)))
99 |
100 | (defn- add-validations [field arg]
101 | (let [validators (if (iterable? arg) arg [arg])]
102 | (reduce (fn [f v] (.addValidator f v) f) field validators)))
103 |
104 | (defn- validate-actions [val]
105 | (or (instance? Action$Handler val)
106 | (and (seq val) (every? #(instance? Action$Listener %) (seq val)))))
107 |
108 | (defn- add-actions [obj _ val]
109 | ;; Assume actions have been validated
110 | (cond
111 | (and (instance? Action$Handler val) (instance? Action$Container obj)) (.addActionHandler obj val)
112 | (instance? Action$Notifier obj) (doseq [a val] (.addAction obj a))
113 | :else (bad-argument "A " (class obj) " does not support adding " (if (seq val) "individual actions" "ActionHandlersƒ"))
114 | )
115 | )
116 |
117 | (def synthetic-option-specs
118 | ""
119 | {
120 | :expandRatio {; OrderedLayout expansionRation
121 | :validate (fn [optval] (or (instance? Double optval) (instance? Float optval)))
122 | :error-msg "Expansion ration must be a Float"
123 | :execute save-for-layout-parent
124 | }
125 | :componentAlignment {;OrderedLayout componentAlignment
126 | :validate (fn [optval] (instance? Alignment optval))
127 | :error-msg "Component alignment must be an Alignment value"
128 | :execute save-for-layout-parent
129 | }
130 | :position {; GridLayout position
131 | :validate (fn [vals] (and (vector? vals) (= 2 (count vals)) (every? integer? vals)))
132 | :error-msg "Grid position must be a vector of two integers"
133 | :execute save-for-grid-parent
134 | }
135 | :span {; GridLayout span
136 | :validate (fn [vals] (and (vector? vals) (= 2 (count vals)) (every? integer? vals)))
137 | :error-msg "Element span must be a vector of two integers"
138 | :execute save-for-grid-parent}
139 | :margin {
140 | :validate validate-margin
141 | :execute (fn [^AbstractOrderedLayout obj opt-key opt-val]
142 | (.setMargin obj (->MarginInfo opt-val)))
143 | :error-msg "Margin info must be true/false or a vector of the keywords [:left :right :top :bottom :vertical :horizontal]"}
144 | :id {
145 | :validate (fn [val] (or (instance? Keyword val) (instance? String val)))
146 | :execute (fn [obj opt-key id]
147 | (if *current-ui* (addComponent *current-ui* obj (keyword id)))
148 | (.setId obj (name id)))
149 | :error-msg "Component ID must be a String or Keyword"}
150 | :bindTo {
151 | :validate (fn [val] (some #(instance? % val) #{Keyword String Map Collection}))
152 | :execute (fn [obj opt-key opt-val] (bind-field obj opt-val))
153 | :error-msg ":bindTo ID must be a String or Keyword"}
154 | :addStyleName {
155 | :validate (fn [val] (instance? String val))
156 | :execute (fn [obj opt-key opt-val] (.addStyleName obj opt-val))
157 | :error-msg "Style name must be a String"}
158 | :validateWith {
159 | :validate check-validators
160 | :execute (fn [obj opt-key opt-val] (add-validations obj opt-val))
161 | :error-msg "Arguments must all be validators"}
162 | :actions {
163 | :validate validate-actions
164 | :execute add-actions
165 | :error-msg "Arguments must be a non-empty list of Action.Listeners or an Action.Handler"
166 | }
167 | :cellStyleGenerator {
168 | :validate fn?
169 | :execute (fn [tbl opt-key opt-val]
170 | (.setCellStyleGenerator tbl
171 | (reify Table$CellStyleGenerator
172 | (getStyle [this table itemId propertyId]
173 | (opt-val itemId propertyId)))))
174 | :error-msg "Cell style generator must be a function"
175 | }
176 | })
177 |
178 | (defn- validate-option [errors [opt-key opt-val] specs]
179 | (if-let [{v-fn :validate msg :error-msg} (get specs opt-key)]
180 | (if (not (v-fn opt-val))
181 | (conj errors msg))
182 | errors)
183 | )
184 |
185 | (defn- validate-config [config specs]
186 | (reduce #(validate-option %1 %2 specs) [] config))
187 |
188 | (defn- translate-config-keys [config]
189 | (reduce (fn [nopts [k v]] (assoc nopts (or (get attribute-translation k) k) v)) {} config))
190 |
191 | (defn- do-synthetic-option [obj [opt-key opt-val]]
192 | ((get-in synthetic-option-specs [opt-key :execute]) obj opt-key opt-val))
193 |
194 | (defn- do-synthetic-options [obj config]
195 | (let [syn-keys (set (keys synthetic-option-specs))]
196 | (reduce (fn [config-opts option]
197 | (if (syn-keys (first option))
198 | (do
199 | (do-synthetic-option obj option)
200 | config-opts)
201 | (merge config-opts option))
202 | ) {} config)))
203 |
204 | (defn- set-attribute
205 | [obj [attribute args]]
206 | (let [arg-list (if (nil? args)
207 | []
208 | (if (not (or (seq? args) (vector? args))) [args] args))
209 | attr-setter (keyword (str "set" (capitalize (name attribute))))
210 | f (get config-table [attr-setter (count arg-list)])]
211 | (if f
212 | (do
213 | (apply f obj arg-list))
214 | (unsupported-op "No such option for " (class obj) ": " attribute))))
215 |
216 | (defn do-configure [obj config]
217 | (doseq [attr-spec config]
218 | (set-attribute obj attr-spec))
219 | obj)
220 |
221 | (defn configure
222 | "Configure a component from a set of options. This extracts and executes any special options, then
223 | configures the component attributes from the remainder"
224 | [obj config]
225 | (if (not (instance? Map config))
226 | (bad-argument "Configuration options must be a Map"))
227 | (let [errors (validate-config config synthetic-option-specs)]
228 | (if (not (empty? errors))
229 | (bad-argument (str/join "\n" errors))))
230 | (->> config
231 | (translate-config-keys)
232 | (do-synthetic-options obj)
233 | (do-configure obj))
234 | obj)
235 |
236 |
--------------------------------------------------------------------------------
/src/functional_vaadin/config_table.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.config-table
9 | "This is auto-generated by the functions in config-gen
10 | DO NOT EDIT"
11 | (:import
12 | (com.vaadin.ui Label Embedded Link MenuBar Upload Button Calendar GridLayout Panel Window VerticalLayout
13 | HorizontalLayout FormLayout TabSheet Accordion VerticalSplitPanel HorizontalSplitPanel Slider TextField TextArea PasswordField
14 | ProgressBar CheckBox RichTextArea InlineDateField PopupDateField Table ComboBox TwinColSelect NativeSelect
15 | ListSelect OptionGroup Tree TreeTable LoginForm
16 | )))
17 |
18 | (def config-table
19 | {
20 | [:setAlternateText 1] (fn [obj arg0] (.setAlternateText obj arg0))
21 | [:setAnimationsEnabled 1] (fn [obj arg0] (.setAnimationsEnabled obj arg0))
22 | [:setArchive 1] (fn [obj arg0] (.setArchive obj arg0))
23 | [:setAssistiveDescription 1] (fn [obj arg0] (.setAssistiveDescription obj arg0))
24 | [:setAssistivePostfix 1] (fn [obj arg0] (.setAssistivePostfix obj arg0))
25 | [:setAssistivePrefix 1] (fn [obj arg0] (.setAssistivePrefix obj arg0))
26 | [:setAssistiveRole 1] (fn [obj arg0] (.setAssistiveRole obj arg0))
27 | [:setAssistiveText 1] (fn [obj arg0] (.setAssistiveText obj arg0))
28 | [:setAutoOpen 1] (fn [obj arg0] (.setAutoOpen obj arg0))
29 | [:setBuffered 1] (fn [obj arg0] (.setBuffered obj arg0))
30 | [:setButtonCaption 1] (fn [obj arg0] (.setButtonCaption obj arg0))
31 | [:setCacheRate 1] (fn [obj arg0] (.setCacheRate obj arg0))
32 | [:setCaption 1] (fn [obj arg0] (.setCaption obj arg0))
33 | [:setCaptionAsHtml 1] (fn [obj arg0] (.setCaptionAsHtml obj arg0))
34 | [:setCellStyleGenerator 1] (fn [obj arg0] (.setCellStyleGenerator obj arg0))
35 | [:setChildMeasurementHint 1] (fn [obj arg0] (.setChildMeasurementHint obj arg0))
36 | [:setChildrenAllowed 2] (fn [obj arg0 arg1] (.setChildrenAllowed obj arg0 arg1))
37 | [:setClassId 1] (fn [obj arg0] (.setClassId obj arg0))
38 | [:setClickShortcut 2] (fn [obj arg0 arg1] (.setClickShortcut obj arg0 arg1))
39 | [:setClosable 1] (fn [obj arg0] (.setClosable obj arg0))
40 | [:setCloseHandler 1] (fn [obj arg0] (.setCloseHandler obj arg0))
41 | [:setCloseShortcut 2] (fn [obj arg0 arg1] (.setCloseShortcut obj arg0 arg1))
42 | [:setCodebase 1] (fn [obj arg0] (.setCodebase obj arg0))
43 | [:setCodetype 1] (fn [obj arg0] (.setCodetype obj arg0))
44 | [:setCollapseMenuContent 1] (fn [obj arg0] (.setCollapseMenuContent obj arg0))
45 | [:setCollapsed 2] (fn [obj arg0 arg1] (.setCollapsed obj arg0 arg1))
46 | [:setColumnAlignment 2] (fn [obj arg0 arg1] (.setColumnAlignment obj arg0 arg1))
47 | [:setColumnAlignments 1] (fn [obj arg0] (.setColumnAlignments obj arg0))
48 | [:setColumnCollapsed 2] (fn [obj arg0 arg1] (.setColumnCollapsed obj arg0 arg1))
49 | [:setColumnCollapsible 2] (fn [obj arg0 arg1] (.setColumnCollapsible obj arg0 arg1))
50 | [:setColumnCollapsingAllowed 1] (fn [obj arg0] (.setColumnCollapsingAllowed obj arg0))
51 | [:setColumnExpandRatio 2] (fn [obj arg0 arg1] (.setColumnExpandRatio obj arg0 arg1))
52 | [:setColumnFooter 2] (fn [obj arg0 arg1] (.setColumnFooter obj arg0 arg1))
53 | [:setColumnHeader 2] (fn [obj arg0 arg1] (.setColumnHeader obj arg0 arg1))
54 | [:setColumnHeaderMode 1] (fn [obj arg0] (.setColumnHeaderMode obj arg0))
55 | [:setColumnHeaders 1] (fn [obj arg0] (.setColumnHeaders obj arg0))
56 | [:setColumnIcon 2] (fn [obj arg0 arg1] (.setColumnIcon obj arg0 arg1))
57 | [:setColumnIcons 1] (fn [obj arg0] (.setColumnIcons obj arg0))
58 | [:setColumnReorderingAllowed 1] (fn [obj arg0] (.setColumnReorderingAllowed obj arg0))
59 | [:setColumnWidth 2] (fn [obj arg0 arg1] (.setColumnWidth obj arg0 arg1))
60 | [:setColumns 1] (fn [obj arg0] (.setColumns obj arg0))
61 | [:setComponentAlignment 2] (fn [obj arg0 arg1] (.setComponentAlignment obj arg0 arg1))
62 | [:setComponentError 1] (fn [obj arg0] (.setComponentError obj arg0))
63 | [:setContainerDataSource 2] (fn [obj arg0 arg1] (.setContainerDataSource obj arg0 arg1))
64 | [:setContainerDataSource 6] (fn [obj arg0 arg1 arg2 arg3 arg4 arg5] (.setContainerDataSource obj arg0 arg1 arg2 arg3 arg4 arg5))
65 | [:setContainerDataSource 1] (fn [obj arg0] (.setContainerDataSource obj arg0))
66 | [:setContent 1] (fn [obj arg0] (.setContent obj arg0))
67 | [:setContentMode 1] (fn [obj arg0] (.setContentMode obj arg0))
68 | [:setConversionError 1] (fn [obj arg0] (.setConversionError obj arg0))
69 | [:setConvertedValue 1] (fn [obj arg0] (.setConvertedValue obj arg0))
70 | [:setConverter 1] (fn [obj arg0] (.setConverter obj arg0))
71 | [:setConverter 2] (fn [obj arg0 arg1] (.setConverter obj arg0 arg1))
72 | [:setCurrentBufferedSourceException 1] (fn [obj arg0] (.setCurrentBufferedSourceException obj arg0))
73 | [:setCurrentPageFirstItemId 1] (fn [obj arg0] (.setCurrentPageFirstItemId obj arg0))
74 | [:setCurrentPageFirstItemIndex 1] (fn [obj arg0] (.setCurrentPageFirstItemIndex obj arg0))
75 | [:setCursorPosition 1] (fn [obj arg0] (.setCursorPosition obj arg0))
76 | [:setCursorX 1] (fn [obj arg0] (.setCursorX obj arg0))
77 | [:setCursorY 1] (fn [obj arg0] (.setCursorY obj arg0))
78 | [:setData 1] (fn [obj arg0] (.setData obj arg0))
79 | [:setDateFormat 1] (fn [obj arg0] (.setDateFormat obj arg0))
80 | [:setDateOutOfRangeMessage 1] (fn [obj arg0] (.setDateOutOfRangeMessage obj arg0))
81 | [:setDebugId 1] (fn [obj arg0] (.setDebugId obj arg0))
82 | [:setDefaultComponentAlignment 1] (fn [obj arg0] (.setDefaultComponentAlignment obj arg0))
83 | [:setDescription 1] (fn [obj arg0] (.setDescription obj arg0))
84 | [:setDisableOnClick 1] (fn [obj arg0] (.setDisableOnClick obj arg0))
85 | [:setDragMode 1] (fn [obj arg0] (.setDragMode obj arg0))
86 | [:setDraggable 1] (fn [obj arg0] (.setDraggable obj arg0))
87 | [:setDropHandler 1] (fn [obj arg0] (.setDropHandler obj arg0))
88 | [:setEditable 1] (fn [obj arg0] (.setEditable obj arg0))
89 | [:setEnabled 1] (fn [obj arg0] (.setEnabled obj arg0))
90 | [:setEndDate 1] (fn [obj arg0] (.setEndDate obj arg0))
91 | [:setErrorHandler 1] (fn [obj arg0] (.setErrorHandler obj arg0))
92 | [:setEventCaptionAsHtml 1] (fn [obj arg0] (.setEventCaptionAsHtml obj arg0))
93 | [:setEventProvider 1] (fn [obj arg0] (.setEventProvider obj arg0))
94 | [:setExpandRatio 2] (fn [obj arg0 arg1] (.setExpandRatio obj arg0 arg1))
95 | [:setFilteringMode 1] (fn [obj arg0] (.setFilteringMode obj arg0))
96 | [:setFirstComponent 1] (fn [obj arg0] (.setFirstComponent obj arg0))
97 | [:setFirstDayOfWeek 1] (fn [obj arg0] (.setFirstDayOfWeek obj arg0))
98 | [:setFirstVisibleDayOfWeek 1] (fn [obj arg0] (.setFirstVisibleDayOfWeek obj arg0))
99 | [:setFirstVisibleHourOfDay 1] (fn [obj arg0] (.setFirstVisibleHourOfDay obj arg0))
100 | [:setFooterVisible 1] (fn [obj arg0] (.setFooterVisible obj arg0))
101 | [:setHandler 1] (fn [obj arg0] (.setHandler obj arg0))
102 | [:setHeight 2] (fn [obj arg0 arg1] (.setHeight obj arg0 arg1))
103 | [:setHeight 1] (fn [obj arg0] (.setHeight obj arg0))
104 | [:setHeightUndefined 0] (fn [obj ] (.setHeightUndefined obj ))
105 | [:setHideEmptyRowsAndColumns 1] (fn [obj arg0] (.setHideEmptyRowsAndColumns obj arg0))
106 | [:setHierarchyColumn 1] (fn [obj arg0] (.setHierarchyColumn obj arg0))
107 | [:setHtmlContentAllowed 1] (fn [obj arg0] (.setHtmlContentAllowed obj arg0))
108 | [:setIcon 1] (fn [obj arg0] (.setIcon obj arg0))
109 | [:setIcon 2] (fn [obj arg0 arg1] (.setIcon obj arg0 arg1))
110 | [:setIconAlternateText 1] (fn [obj arg0] (.setIconAlternateText obj arg0))
111 | [:setId 1] (fn [obj arg0] (.setId obj arg0))
112 | [:setImmediate 1] (fn [obj arg0] (.setImmediate obj arg0))
113 | [:setIndeterminate 1] (fn [obj arg0] (.setIndeterminate obj arg0))
114 | [:setInputPrompt 1] (fn [obj arg0] (.setInputPrompt obj arg0))
115 | [:setInvalidAllowed 1] (fn [obj arg0] (.setInvalidAllowed obj arg0))
116 | [:setInvalidCommitted 1] (fn [obj arg0] (.setInvalidCommitted obj arg0))
117 | [:setItemCaption 2] (fn [obj arg0 arg1] (.setItemCaption obj arg0 arg1))
118 | [:setItemCaptionMode 1] (fn [obj arg0] (.setItemCaptionMode obj arg0))
119 | [:setItemCaptionPropertyId 1] (fn [obj arg0] (.setItemCaptionPropertyId obj arg0))
120 | [:setItemDescriptionGenerator 1] (fn [obj arg0] (.setItemDescriptionGenerator obj arg0))
121 | [:setItemEnabled 2] (fn [obj arg0 arg1] (.setItemEnabled obj arg0 arg1))
122 | [:setItemIcon 2] (fn [obj arg0 arg1] (.setItemIcon obj arg0 arg1))
123 | [:setItemIcon 3] (fn [obj arg0 arg1 arg2] (.setItemIcon obj arg0 arg1 arg2))
124 | [:setItemIconAlternateText 2] (fn [obj arg0 arg1] (.setItemIconAlternateText obj arg0 arg1))
125 | [:setItemIconPropertyId 1] (fn [obj arg0] (.setItemIconPropertyId obj arg0))
126 | [:setItemStyleGenerator 1] (fn [obj arg0] (.setItemStyleGenerator obj arg0))
127 | [:setLastVisibleDayOfWeek 1] (fn [obj arg0] (.setLastVisibleDayOfWeek obj arg0))
128 | [:setLastVisibleHourOfDay 1] (fn [obj arg0] (.setLastVisibleHourOfDay obj arg0))
129 | [:setLeftColumnCaption 1] (fn [obj arg0] (.setLeftColumnCaption obj arg0))
130 | [:setLenient 1] (fn [obj arg0] (.setLenient obj arg0))
131 | [:setLocale 1] (fn [obj arg0] (.setLocale obj arg0))
132 | [:setLocked 1] (fn [obj arg0] (.setLocked obj arg0))
133 | [:setLoginButtonCaption 1] (fn [obj arg0] (.setLoginButtonCaption obj arg0))
134 | [:setLoginButtonFunc 1] (fn [obj arg0] (.setLoginButtonFunc obj arg0))
135 | [:setMargin 1] (fn [obj arg0] (.setMargin obj arg0))
136 | [:setMax 1] (fn [obj arg0] (.setMax obj arg0))
137 | [:setMaxLength 1] (fn [obj arg0] (.setMaxLength obj arg0))
138 | [:setMaxSplitPosition 2] (fn [obj arg0 arg1] (.setMaxSplitPosition obj arg0 arg1))
139 | [:setMimeType 1] (fn [obj arg0] (.setMimeType obj arg0))
140 | [:setMin 1] (fn [obj arg0] (.setMin obj arg0))
141 | [:setMinSplitPosition 2] (fn [obj arg0 arg1] (.setMinSplitPosition obj arg0 arg1))
142 | [:setModal 1] (fn [obj arg0] (.setModal obj arg0))
143 | [:setMoreMenuItem 1] (fn [obj arg0] (.setMoreMenuItem obj arg0))
144 | [:setMultiSelect 1] (fn [obj arg0] (.setMultiSelect obj arg0))
145 | [:setMultiSelectMode 1] (fn [obj arg0] (.setMultiSelectMode obj arg0))
146 | [:setMultiselectMode 1] (fn [obj arg0] (.setMultiselectMode obj arg0))
147 | [:setNewItemHandler 1] (fn [obj arg0] (.setNewItemHandler obj arg0))
148 | [:setNewItemsAllowed 1] (fn [obj arg0] (.setNewItemsAllowed obj arg0))
149 | [:setNullRepresentation 1] (fn [obj arg0] (.setNullRepresentation obj arg0))
150 | [:setNullSelectionAllowed 1] (fn [obj arg0] (.setNullSelectionAllowed obj arg0))
151 | [:setNullSelectionItemId 1] (fn [obj arg0] (.setNullSelectionItemId obj arg0))
152 | [:setNullSettingAllowed 1] (fn [obj arg0] (.setNullSettingAllowed obj arg0))
153 | [:setOrientation 1] (fn [obj arg0] (.setOrientation obj arg0))
154 | [:setPageLength 1] (fn [obj arg0] (.setPageLength obj arg0))
155 | [:setParameter 2] (fn [obj arg0 arg1] (.setParameter obj arg0 arg1))
156 | [:setParent 1] (fn [obj arg0] (.setParent obj arg0))
157 | [:setParent 2] (fn [obj arg0 arg1] (.setParent obj arg0 arg1))
158 | [:setParseErrorMessage 1] (fn [obj arg0] (.setParseErrorMessage obj arg0))
159 | [:setPasswordCaption 1] (fn [obj arg0] (.setPasswordCaption obj arg0))
160 | [:setPasswordFieldFunc 1] (fn [obj arg0] (.setPasswordFieldFunc obj arg0))
161 | [:setPopupWidth 1] (fn [obj arg0] (.setPopupWidth obj arg0))
162 | [:setPosition 2] (fn [obj arg0 arg1] (.setPosition obj arg0 arg1))
163 | [:setPositionX 1] (fn [obj arg0] (.setPositionX obj arg0))
164 | [:setPositionY 1] (fn [obj arg0] (.setPositionY obj arg0))
165 | [:setPrimaryStyleName 1] (fn [obj arg0] (.setPrimaryStyleName obj arg0))
166 | [:setPropertyDataSource 1] (fn [obj arg0] (.setPropertyDataSource obj arg0))
167 | [:setRangeEnd 1] (fn [obj arg0] (.setRangeEnd obj arg0))
168 | [:setRangeStart 1] (fn [obj arg0] (.setRangeStart obj arg0))
169 | [:setReadOnly 1] (fn [obj arg0] (.setReadOnly obj arg0))
170 | [:setReceiver 1] (fn [obj arg0] (.setReceiver obj arg0))
171 | [:setRequired 1] (fn [obj arg0] (.setRequired obj arg0))
172 | [:setRequiredError 1] (fn [obj arg0] (.setRequiredError obj arg0))
173 | [:setResizable 1] (fn [obj arg0] (.setResizable obj arg0))
174 | [:setResizeLazy 1] (fn [obj arg0] (.setResizeLazy obj arg0))
175 | [:setResolution 1] (fn [obj arg0] (.setResolution obj arg0))
176 | [:setResource 1] (fn [obj arg0] (.setResource obj arg0))
177 | [:setResource 2] (fn [obj arg0 arg1] (.setResource obj arg0 arg1))
178 | [:setResponsive 1] (fn [obj arg0] (.setResponsive obj arg0))
179 | [:setRightColumnCaption 1] (fn [obj arg0] (.setRightColumnCaption obj arg0))
180 | [:setRowExpandRatio 2] (fn [obj arg0 arg1] (.setRowExpandRatio obj arg0 arg1))
181 | [:setRowGenerator 1] (fn [obj arg0] (.setRowGenerator obj arg0))
182 | [:setRowHeaderMode 1] (fn [obj arg0] (.setRowHeaderMode obj arg0))
183 | [:setRows 1] (fn [obj arg0] (.setRows obj arg0))
184 | [:setScrollLeft 1] (fn [obj arg0] (.setScrollLeft obj arg0))
185 | [:setScrollToSelectedItem 1] (fn [obj arg0] (.setScrollToSelectedItem obj arg0))
186 | [:setScrollTop 1] (fn [obj arg0] (.setScrollTop obj arg0))
187 | [:setSecondComponent 1] (fn [obj arg0] (.setSecondComponent obj arg0))
188 | [:setSelectable 1] (fn [obj arg0] (.setSelectable obj arg0))
189 | [:setSelectedTab 1] (fn [obj arg0] (.setSelectedTab obj arg0))
190 | [:setSelectionRange 2] (fn [obj arg0 arg1] (.setSelectionRange obj arg0 arg1))
191 | [:setShowISOWeekNumbers 1] (fn [obj arg0] (.setShowISOWeekNumbers obj arg0))
192 | [:setSizeFull 0] (fn [obj ] (.setSizeFull obj ))
193 | [:setSizeUndefined 0] (fn [obj ] (.setSizeUndefined obj ))
194 | [:setSortAscending 1] (fn [obj arg0] (.setSortAscending obj arg0))
195 | [:setSortContainerPropertyId 1] (fn [obj arg0] (.setSortContainerPropertyId obj arg0))
196 | [:setSortDisabled 1] (fn [obj arg0] (.setSortDisabled obj arg0))
197 | [:setSortEnabled 1] (fn [obj arg0] (.setSortEnabled obj arg0))
198 | [:setSource 1] (fn [obj arg0] (.setSource obj arg0))
199 | [:setSpacing 1] (fn [obj arg0] (.setSpacing obj arg0))
200 | [:setSplitPosition 3] (fn [obj arg0 arg1 arg2] (.setSplitPosition obj arg0 arg1 arg2))
201 | [:setSplitPosition 2] (fn [obj arg0 arg1] (.setSplitPosition obj arg0 arg1))
202 | [:setSplitPosition 1] (fn [obj arg0] (.setSplitPosition obj arg0))
203 | [:setStandby 1] (fn [obj arg0] (.setStandby obj arg0))
204 | [:setStartDate 1] (fn [obj arg0] (.setStartDate obj arg0))
205 | [:setStyleName 1] (fn [obj arg0] (.setStyleName obj arg0))
206 | [:setStyleName 2] (fn [obj arg0 arg1] (.setStyleName obj arg0 arg1))
207 | [:setTabCaptionsAsHtml 1] (fn [obj arg0] (.setTabCaptionsAsHtml obj arg0))
208 | [:setTabIndex 1] (fn [obj arg0] (.setTabIndex obj arg0))
209 | [:setTabPosition 2] (fn [obj arg0 arg1] (.setTabPosition obj arg0 arg1))
210 | [:setTabStopBottomAssistiveText 1] (fn [obj arg0] (.setTabStopBottomAssistiveText obj arg0))
211 | [:setTabStopEnabled 1] (fn [obj arg0] (.setTabStopEnabled obj arg0))
212 | [:setTabStopTopAssistiveText 1] (fn [obj arg0] (.setTabStopTopAssistiveText obj arg0))
213 | [:setTableFieldFactory 1] (fn [obj arg0] (.setTableFieldFactory obj arg0))
214 | [:setTabsVisible 1] (fn [obj arg0] (.setTabsVisible obj arg0))
215 | [:setTargetBorder 1] (fn [obj arg0] (.setTargetBorder obj arg0))
216 | [:setTargetHeight 1] (fn [obj arg0] (.setTargetHeight obj arg0))
217 | [:setTargetName 1] (fn [obj arg0] (.setTargetName obj arg0))
218 | [:setTargetWidth 1] (fn [obj arg0] (.setTargetWidth obj arg0))
219 | [:setTextChangeEventMode 1] (fn [obj arg0] (.setTextChangeEventMode obj arg0))
220 | [:setTextChangeTimeout 1] (fn [obj arg0] (.setTextChangeTimeout obj arg0))
221 | [:setTextFieldEnabled 1] (fn [obj arg0] (.setTextFieldEnabled obj arg0))
222 | [:setTextInputAllowed 1] (fn [obj arg0] (.setTextInputAllowed obj arg0))
223 | [:setTimeFormat 1] (fn [obj arg0] (.setTimeFormat obj arg0))
224 | [:setTimeZone 1] (fn [obj arg0] (.setTimeZone obj arg0))
225 | [:setType 1] (fn [obj arg0] (.setType obj arg0))
226 | [:setUsernameCaption 1] (fn [obj arg0] (.setUsernameCaption obj arg0))
227 | [:setUsernameFieldFunc 1] (fn [obj arg0] (.setUsernameFieldFunc obj arg0))
228 | [:setValidationVisible 1] (fn [obj arg0] (.setValidationVisible obj arg0))
229 | [:setValue 1] (fn [obj arg0] (.setValue obj arg0))
230 | [:setVisible 1] (fn [obj arg0] (.setVisible obj arg0))
231 | [:setVisibleColumns 1] (fn [obj arg0] (.setVisibleColumns obj arg0))
232 | [:setWeeklyCaptionFormat 1] (fn [obj arg0] (.setWeeklyCaptionFormat obj arg0))
233 | [:setWidth 2] (fn [obj arg0 arg1] (.setWidth obj arg0 arg1))
234 | [:setWidth 1] (fn [obj arg0] (.setWidth obj arg0))
235 | [:setWidthUndefined 0] (fn [obj ] (.setWidthUndefined obj ))
236 | [:setWindowMode 1] (fn [obj arg0] (.setWindowMode obj arg0))
237 | [:setWordwrap 1] (fn [obj arg0] (.setWordwrap obj arg0))
238 | })
--------------------------------------------------------------------------------
/src/functional_vaadin/core.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.core
9 | "The primary namespace for the project, contains all publically accesible buidlers and vars.
10 |
11 | All builder functions take a variable number of orguments, all of a similar form:
12 |
13 | ( ctor-arguments? config? & children)
14 |
15 | where:
16 |
17 | ctor-arguments: are any set of constructor arguments for the corresponding component, as defined in the Vaadin javadoc.
18 | if this is not supplied, the null constructor will be used.
19 |
20 | config: is a Map of attribute-vaue pairs corresponding to setters on the Component. The names are the same as the
21 | setter name, minus the 'set' prefix, and all lower case e.g. the config '{:id \"this-como\"} will set
22 | the 'id' attribute using setId(val)
23 |
24 | Certain config items can take more convenient specification of value:
25 |
26 | :margin - can be either \"true\", indicating full margins, or an array of any combination of :top, :bottom,
27 | :left, :right, :vertical or :horizontal, indicating that margins should be added to the
28 | respective location(s)
29 |
30 | :validateWith - adds a validator to a Field. The argument is any Vaadin Validator instance. There is also
31 | a Clojure type FunctionalValidator which can be used to create a Validator from an arbitrary function.
32 |
33 | :id - will set the component id, and also allow lookup via (component-named). This removes the need to
34 | use temporary variables when referencing already-built components.
35 |
36 | :addStyleNamed - will add a style to a component. The name is a String
37 |
38 | Positioning and expansion options that Vaadin requires specified on the parent can now be placed on the child -
39 | these include :expansionRatio, :componentAlignment, :position and :span
40 |
41 | children: are the Components child Components, which will be added as appropriate
42 | "
43 |
44 | (:require [clojure.set :as set]
45 | [clojure.spec.alpha :as s]
46 | [functional-vaadin.naming :as nm]
47 | [functional-vaadin.thread-vars :refer :all]
48 | [functional-vaadin.build-support :refer :all]
49 | [functional-vaadin.utils :refer :all])
50 | (:import (com.vaadin.ui
51 | MenuBar
52 | Label Embedded Link Button
53 | Panel VerticalLayout HorizontalLayout FormLayout GridLayout TabSheet VerticalSplitPanel HorizontalSplitPanel
54 | TextField TextArea PasswordField RichTextArea InlineDateField PopupDateField Slider CheckBox
55 | ComboBox TwinColSelect NativeSelect ListSelect OptionGroup
56 | Table Tree TreeTable Accordion
57 | Component UI Image ProgressBar Window Upload LoginForm$LoginListener LoginForm$LoginEvent)
58 | (com.vaadin.data.fieldgroup FieldGroup)
59 | (com.vaadin.data.util PropertysetItem)
60 | (com.vaadin.event ShortcutAction Action$Listener ActionManager)
61 | (com.vaadin.data.util.converter Converter)
62 | (functional_vaadin.ui LoginForm)))
63 |
64 | ; TODO - grid, calendar, popupview, browser-frame, audio, video, color picker, flash, notification
65 | ; TODO - layouts: absolute, css, custom(?)
66 | ; TODO - registering custom components? Custon layout, field, component
67 | ; TODO - drag and drop
68 |
69 | ;; Primary build macro
70 |
71 | (defmacro defui
72 | "Defines a Vaadin UI using the builder syntax. Given a com.vaadin.ui.UI object and a series of builder forms, creates
73 | and installs the generated components on the UI object."
74 | [^UI ui top-form]
75 | `(let [this-ui# ~ui]
76 | (with-bindings
77 | {#'*current-ui* this-ui#}
78 | (let [root# ~top-form]
79 | (if (instance? Component root#)
80 | (.setContent *current-ui* root#)
81 | (unsupported-op "The generated UI is not a Vaadin Component")))
82 | )
83 | this-ui#))
84 |
85 | ;; Public functions - named component access
86 |
87 | (defn componentNamed
88 | "Return a component named with an : configuration attriute in the given UI"
89 | [key ui]
90 | (nm/componentAt ui key))
91 |
92 | ;; Auxiliary objects - actions, etc.
93 |
94 | (defn ^{:deprecated "0.3.0"} shortcutAction
95 | "Deprecated. Use (->ShortcutAction) instead
96 | "
97 | ([name keycode a-fn modifiers]
98 | (proxy [ShortcutAction Action$Listener] [name (int keycode) (int-array modifiers)]
99 | (handleAction [sender target] (a-fn this sender target))))
100 | ([name keycode a-fn] (shortcutAction name keycode a-fn []))
101 | )
102 |
103 | (deftype FunctionalConverter [to-model-fn to-presn-fn model-type presn-type]
104 | Converter
105 | (convertToModel [this value type locale] (to-model-fn value type locale))
106 | (convertToPresentation [this value type locale] (to-presn-fn value type locale))
107 | (getModelType [this] model-type)
108 | (getPresentationType [this] presn-type)
109 | )
110 |
111 | ;; Base components - Button, Link, Label etc.
112 |
113 | (defn button
114 | "Usage: (button ctor_args? config_map?)
115 |
116 | Create a Button component from constructor arguments or a configuration Map"
117 | [& args]
118 | (create-widget Button args))
119 |
120 |
121 | (defn link
122 | "Usage: (link ctor_args? config_map?)
123 |
124 | Create a Link component from constructor arguments or a single configuration Map"
125 | [& args]
126 | (create-widget Link args))
127 |
128 | (defn label
129 | "Usage: (label ctor_args? config_map?)
130 |
131 | Create a Label component from constructor arguments or a configuration Map"
132 | [& args]
133 | (create-widget Label args))
134 |
135 | ;; Fields
136 |
137 | (defn text-field
138 | "Usage: (text-field ctor_args? config_map?)
139 |
140 | Create a TextField component from constructor arguments or a configuration Map."
141 | [& args]
142 | (create-widget TextField args))
143 |
144 | (defn password-field
145 | "Usage: (password-field ctor_args? config_map?)
146 |
147 | Create a PassowrdField component from constructor arguments or a configuration Map"
148 | [& args]
149 | (create-widget PasswordField args))
150 |
151 | (defn text-area
152 | "Usage: (text-area ctor_args? config_map?)
153 |
154 | Create a TextArea component from constructor arguments or a configuration Map."
155 | [& args]
156 | (create-widget TextArea args))
157 |
158 | (defn rich-text-area
159 | "Usage: (rich-text-area ctor_args? config_map?)
160 |
161 | Create a RichTextArea component from constructor arguments or a configuration Map."
162 | [& args]
163 | (create-widget RichTextArea args))
164 |
165 | (defn inline-date-field
166 | "Usage: (inline-date-field ctor_args? config_map?)
167 |
168 | Create a InineDateField component from constructor arguments or a configuration Map."
169 | [& args]
170 | (create-widget InlineDateField args))
171 |
172 | (defn popup-date-field
173 | "Usage: (popup-date-field ctor_args? config_map?)
174 |
175 | Create a PopupDateField component from constructor arguments and/or a configuration Map."
176 | [& args]
177 | (create-widget PopupDateField args))
178 |
179 | (defn slider
180 | "Usage: (slider ctor_args? config_map?)
181 |
182 | Create a Slider component from constructor arguments or a configuration Map."
183 | [& args]
184 | (create-widget Slider args))
185 |
186 | (defn check-box
187 | "Usage: (check-box ctor_args? config_map?)
188 |
189 | Create a CheckBox component from constructor arguments or a configuration Map."
190 | [& args]
191 | (create-widget CheckBox args))
192 |
193 | (defn combo-box
194 | "Usage: (combo-box ctor_args? config_map?)
195 |
196 | Create a ComboBox component from constructor arguments or a configuration Map."
197 | [& args]
198 | (create-widget ComboBox args))
199 |
200 | (defn twin-col-select
201 | "Usage: (twin-col-select ctor_args? config_map?)
202 |
203 | Create a TwinColSelect component from constructor arguments or a configuration Map."
204 | [& args]
205 | (create-widget TwinColSelect args))
206 |
207 | (defn native-select
208 | "Usage: (native-select ctor_args? config_map?)
209 |
210 | Create a NativeSelect component from constructor arguments or a configuration Map."
211 | [& args]
212 | (create-widget NativeSelect args))
213 |
214 | (defn list-select
215 | "Usage: (list-select ctor_args? config_map?)
216 |
217 | Create a ListSelect component from constructor arguments or a configuration Map."
218 | [& args]
219 | (create-widget ListSelect args))
220 |
221 | (defn option-group
222 | "Usage: (option-group ctor_args? config_map?)
223 |
224 | Create an OptionGroup component from constructor arguments or a configuration Map."
225 | [& args]
226 | (create-widget OptionGroup args))
227 |
228 | (defn progress-bar
229 | "Usage: (progress-bar ctor_args? config_map?)
230 |
231 | Create a ProgressBar component from constructor arguments or a configuration Map."
232 | [& args]
233 | (create-widget ProgressBar args))
234 |
235 | (defn upload
236 | "Usage: (upload ctor_args? config_map?)
237 |
238 | Create an Upload component from constructor arguments or a configuration Map."
239 | [& args]
240 | (create-widget Upload args))
241 |
242 | (s/def ::login-form-args
243 | (s/cat :config (s/? map?) :login-fn fn?))
244 |
245 | (defn- onLogin [^LoginForm source act-fn]
246 | (.addLoginListener
247 | source
248 | (reify
249 | LoginForm$LoginListener
250 | (^void onLogin [this ^LoginForm$LoginEvent event]
251 | (act-fn (.getSource event) event (.getLoginParameter event "username") (.getLoginParameter event "password")))))
252 | source)
253 |
254 | (defn login-form
255 | "Usage: (login-form config_map? login-fn)
256 |
257 | Create an LoginForm component from a login function and an optional configuration Map. The login function will be called
258 | with arguments \"[source event username password]\" when the loginform is submitted.
259 |
260 | The optional config can set the usual setters on LoginForm, and also accepts options
261 | to alter the creation of the login button, user name and password fields:
262 |
263 | option :loginButtonFunc takes a function that should return the login button component. It must be a Button
264 | option :usernameFieldFunc takes a function that should return the user name field. It must be a TextField
265 | option :passwordFieldFunc takes a function that should return the password field. It must be a TextField
266 |
267 | Defaults for these are as for com.vaadin.ui.LoginForm"
268 | [& args]
269 | (let [parsed-args (s/conform ::login-form-args args)]
270 | (if (= parsed-args ::s/invalid)
271 | (apply bad-argument (if (zero? (count args))
272 | ["No arguments supplied to login-form"]
273 | ["Bad arguments for login-form: " args]))
274 | (->
275 | (create-widget LoginForm ((fnil list {}) (:config parsed-args)))
276 | (onLogin (:login-fn parsed-args))))))
277 |
278 | ;(defn file-upload
279 | ; "Usage: (file-upload config_map? filename)
280 | ;
281 | ; A convenience function to create a file upload. \"filename\" is a server pathname where the file will be uploaded,
282 | ; \"config_map\" is a map of configuration options:
283 | ;
284 | ; :showProgress - show a progress bar of the upload state, true/false, default false
285 | ; :onFailed - a function to call on failure. Arguments are the upload and event
286 | ; :onSucceeded - a function to call on success. Arguments are the upload and event
287 | ; :onChanged - a function to call when filename is changed. Arguments are the upload, event, and the new value"
288 | ; )
289 |
290 | ;; Containers and layouts
291 |
292 | (defn tree
293 | "Usage: (tree ctor_args? config_map?)
294 |
295 | Create a Tree component from constructor arguments or a configuration Map."
296 | [& args]
297 | (create-widget Tree args))
298 |
299 | (defn panel
300 | "Usage: (panel ctor_args? config_map? children?)
301 |
302 | Create a Panel component from constructor arguments or a configuration Map. Content can be set as either a constructor argument,
303 | configuration option, or a single child. If the content is set via constructor or configuration, multiple children may be given,
304 | and will be added as children of the panel content (if applicable)"
305 | [& args]
306 | (let [[panel children] (create-widget Panel args true)]
307 | (add-children panel children)))
308 |
309 | (defn vertical-layout
310 | "Usage: (vertical-layout ctor_args? config_map? children?)
311 |
312 | Create a VerticalLayout component from constructor arguments or a configuration Map. Remaining arguments are children.
313 | Expansion ration and alignment parameters are placed on the children, not the layout itself"
314 | [& args]
315 | (let [[vl children] (create-widget VerticalLayout args true)]
316 | (add-children vl children)))
317 |
318 | (defn horizontal-layout
319 | "Usage: (horizontal-layout ctor_args? config_map? children?)
320 |
321 | Create a HorizontalLayout component from constructor arguments or a configuration Map. Remaining arguments are children.
322 | Expansion ration a alignment parameters areplaced on the children, not the layout itself"
323 | [& args]
324 | (let [[hl children] (create-widget HorizontalLayout args true)]
325 | (add-children hl children)))
326 |
327 | (defn form-layout
328 | "Usage: (form-layout ctor_args? config_map? children?)
329 |
330 | Create a FormLayout component from constructor arguments or a configuration Map. Remaining arguments are children.."
331 | [& args]
332 | (let [[hl children] (create-widget FormLayout args true)]
333 | (add-children hl children)))
334 |
335 | (defn grid-layout
336 | "Usage: (grid-layout ctor_args? config_map? children?)
337 |
338 | Create a GridLayout component from constructor arguments or a configuration Map. Remaining arguments are children.
339 | Childen may have :position and :span configuration options to specify their position and size"
340 | [& args]
341 | (let [[hl children] (create-widget GridLayout args true)]
342 | (add-children hl children)))
343 |
344 | (defn tab-sheet
345 | "Usage: (tab-sheet ctor_args? config_map? children?)
346 |
347 | Create a TabSheet componentfrom constructor arguments or a configuration Map. Remaining arguments are children.."
348 | [& args]
349 | (let [[ts children] (create-widget TabSheet args true)]
350 | (add-children ts children)))
351 |
352 | (defn accordion
353 | "Usage: (accordion ctor_args? config_map? children?)
354 |
355 | Create an Accordion component from constructor arguments or a configuration Map. Remaining arguments are children.."
356 | [& args]
357 | (let [[acc children] (create-widget Accordion args true)]
358 | (add-children acc children)))
359 |
360 | (defn vertical-split-panel
361 | "Usage: (vertical-split-panel ctor_args? config_map? children?)
362 |
363 | Create a VerticalSplitPanel component from constructor arguments or a configuration Map. Only zero or two children may
364 | be specified"
365 | [& args]
366 | (let [[sl children] (create-widget VerticalSplitPanel args true)]
367 | (add-children sl children)))
368 |
369 | (defn horizontal-split-panel
370 | "Usage: (horizontal-split-panel ctor_args? config_map? children?)
371 |
372 | Create a HorizontalSplitPanel component from constructor arguments or a configuration Map. Only zero or two children may
373 | be specified"
374 | [& args]
375 | (let [[sl children] (create-widget HorizontalSplitPanel args true)]
376 | (add-children sl children)))
377 |
378 | ; A MenuBar acts like a container for MenuItems
379 |
380 | (defn menu-bar
381 | "Usage: (menu-bar ctor_args? config_map? menu-items?)
382 |
383 | Create a MenuBar. Children must be MenuItem builders."
384 | [& args]
385 | (let [[mb items] (create-widget MenuBar args true)]
386 | (add-children mb items)
387 | mb))
388 |
389 |
390 | (defn menu-item
391 | "Usage: (menu-item name icon_resource? [menu-fn | menu-items])
392 |
393 | Create a menu item for the contaning menu. \"name\" is the menu item name, \"icon\" is and optional Resource that
394 | defines the menu item icon. Further arguments are either a single fn defining the menu action, or further menu-items
395 | defining a sub-menu
396 |
397 | When triggered, the menu-fn is called with the selected MenuItem"
398 |
399 | ;[name & args]
400 | ;(if (not (instance? String name))
401 | ; (bad-argument "Menu name must be a String: " name))
402 | ;(parse-menu-item name args)
403 | [& args]
404 | (let [parsed-args (s/conform ::functional-vaadin.build-support/menu-item-args args)]
405 | (if (= parsed-args ::s/invalid)
406 | (bad-argument (s/explain-str ::functional-vaadin.build-support/menu-item-args args))
407 | (->MenuItemSpec
408 | (:name parsed-args)
409 | (:icon_resource parsed-args)
410 | (second (:children parsed-args)))))
411 | )
412 |
413 | (defn menu-separator
414 | "Usage: (menu-separator)
415 |
416 | Create a menu separator in a menu."
417 | []
418 | (->MenItemSeparator))
419 |
420 | ;; Forms
421 |
422 | (defmacro form
423 | "Usage: (form [^ComponentContainer content] [^Map config] children*)
424 |
425 | Create a Form. This is a pseudo component that returns a ComponentConainer with an added Field Group. The FieldGroup
426 | is made available for binding form (children) fields, and in all event handlers attached to form components
427 |
428 | The content may be specified directly as the first argument, which must be a ComponentContainer, or as a :content
429 | configuration option. Any remaining configuration optiond are applied to the container. If neither are present the
430 | contnet defaults to a FormLayout"
431 | [& args]
432 | `(with-bindings {#'*current-field-group* (FieldGroup. (PropertysetItem.))}
433 | (let [[l# c#] (create-form-content (list ~@args))]
434 | (add-children l# c#)
435 | (set-field-group l# *current-field-group*)
436 | l#)))
437 |
438 |
439 | ;; Embedded items
440 |
441 | (defn image
442 | "Usage: (image ctor_args? config_map?)
443 |
444 | Create an Image component from constructor arguments or a configuration Map."
445 | [& args]
446 | (create-widget Image args))
447 |
448 | (defn embedded
449 | "Usage: (embedded ctor_args? config_map?)
450 |
451 | Create an Embedded component from constructor arguments or a configuration Map."
452 | [& args]
453 | (create-widget Embedded args))
454 |
455 | ;; Tables
456 |
457 | (defn table-column
458 | "Usage: (table-column property_id config_map? gen_fn?)
459 |
460 | Create a table column. Only valid as a child of a Table component. The first argument must be the name of the
461 | data binding property that the column will bind to. Other config options can be the type (:type) and default value
462 | (:default) of the property, plus any of the table setColumnXXX setters. These will be configured on the table as
463 | for other config options.
464 |
465 | Generated table columns can be added by adding a generation function. This will be called as
466 |
467 | (gen_fn table itemId columnId)
468 |
469 | Both the config_map and gen_fn are optional, defaults are a standard table column of type Object and a default
470 | value of nil
471 | "
472 | ([propertyId config gen_fn]
473 | (->GeneratedTableColumn propertyId config gen_fn))
474 | ([propertyId config_or_fn]
475 | (if (fn? config_or_fn)
476 | (->GeneratedTableColumn propertyId {} config_or_fn)
477 | (->TableColumn
478 | propertyId
479 | (merge {:type Object :defaultValue nil} config_or_fn)))
480 | )
481 | ([propertyId] (table-column propertyId {}))
482 | )
483 |
484 | (defn table
485 | "Usage: (table ctor_args? config_map? table-columns?)
486 |
487 | Create a Table component from constructor arguments or a configuration Map. Children must be table-column specifications"
488 | [& args]
489 | (let [[table children] (create-widget Table args true)]
490 | (add-children table children)))
491 |
492 | (defn tree-table
493 | "Usage: (tree-table ctor_args? config_map? table-columns?)
494 |
495 | Create a TreeTable component from constructor arguments or a configuration Map. Children must be table-column specifications"
496 | [& args]
497 | (let [[tree-table children] (create-widget TreeTable args true)]
498 | (add-children tree-table children)))
499 |
500 | ;; Window
501 |
502 | (defn window
503 | "Usage: (window ctor_args? config_map? children?)
504 |
505 | Create a Window component from constructor arguments or a configuration Map. Content may be specified as for a Panel"
506 | [& args]
507 | (if-let [ui (UI/getCurrent)]
508 | (let [[window children] (create-widget Window args true)]
509 | (add-children window children)
510 | (.addWindow ui window)
511 | window)))
512 |
513 | ;; ActionManager
514 |
515 | (defn action-manager
516 | "Usage: (action-manager ctor_args? config_map?
517 |
518 | Creates an ActionManager for general use"
519 | [& args]
520 | (create-widget ActionManager args))
521 |
522 |
523 |
524 |
525 |
526 |
--------------------------------------------------------------------------------
/src/functional_vaadin/data_binding.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.data-binding
9 | "Utilities for converting between Clojure data structures and Vaadin data binding objects -
10 | Property, Item and Container"
11 | (:require [functional-vaadin.utils :refer :all])
12 | (:import (com.vaadin.data.util ObjectProperty PropertysetItem IndexedContainer HierarchicalContainer)
13 | (java.util Map Collection)
14 | (com.vaadin.data Property Item Container)))
15 |
16 | (defn ->Property
17 | "Create a Property from some data. The type can be supplied directly or implied from the given
18 | (non-nil) data"
19 | ([data] (->Property data (if data (class data) Object)))
20 | ([data type] (ObjectProperty. data type)))
21 |
22 | (defn <-Property
23 | "Extract the data in a Property"
24 | [^Property property]
25 | {:pre [(instance? Property property)]}
26 | (.getValue property))
27 |
28 | (defn ->Item
29 | "Convert a Map object to a com.vaadin,data.Item"
30 | [data]
31 | {:pre [instance? Map data]}
32 | (reduce (fn [item [k v]] (.addItemProperty item k (->Property v)) item)
33 | (PropertysetItem.)
34 | data))
35 |
36 | (defn <-Item
37 | "Extract the data in an Item to a Clojure hash-map" [^Item item]
38 | {:pre [(instance? Item item)]}
39 | (persistent!
40 | (reduce (fn [map pid] (assoc! map pid (.getValue (.getItemProperty item pid))))
41 | (transient {})
42 | (.getItemPropertyIds item)))
43 | )
44 |
45 | (defn- add-data-map-item
46 | "Add a Container Item represented by a Map. The id is the data index, and the Map is the data-value
47 | Container property ids are the union of all Maps added"
48 | [container item-id map-item]
49 | (.addItem container item-id)
50 | (doseq [[k v] map-item]
51 | (if (not ((set (.getContainerPropertyIds container)) k))
52 | (.addContainerProperty container k (class v) nil))
53 | (.setValue (.getContainerProperty container item-id k) v))
54 | container)
55 |
56 | (defn- add-data-value-item
57 | "Add a Container Item with an item id that is the data value"
58 | [container data-id data-value]
59 | (.addItem container data-value)
60 | container)
61 |
62 | (defn- create-container [data add-fn]
63 | (let [data-vec (vec data)
64 | ^IndexedContainer container (IndexedContainer.)]
65 | (doseq [data-index (range 0 (count data-vec))]
66 | (add-fn container data-index (nth data data-index)))
67 | container))
68 |
69 | (defmulti ->Container
70 | "Create a Container from some data. The data structure determines how the data is added. Collections of Maps
71 | add Items to the Container (as would be constructed by ->Item), and use the collection index as the Item id.
72 | Collections of other objects use those objects as Item ids, but do not add Properties to those items. This is
73 | useful for setting the data for selection components (derived from com.vaadin.ui.AbstractSelect)"
74 | (fn [data]
75 | {:pre [(instance? Collection data)]}
76 | (let [vec-data (vec data)]
77 | (cond
78 | (empty? data) :CollectionAny
79 | (instance? Map (first vec-data)) :CollectionMap
80 | (not (instance? Collection (first vec-data))) :CollectionAny
81 | :else :Unknown))
82 | ))
83 |
84 | (defmethod ->Container :CollectionAny [data]
85 | (create-container data add-data-value-item))
86 |
87 | (defmethod ->Container :CollectionMap [data]
88 | (create-container data add-data-map-item))
89 |
90 | (defmethod ->Container :Unknown [data]
91 | (bad-argument "Cannot create a Container from " data))
92 |
93 | (defn <-Container
94 | "Extract data from a Container in such a way that (<-Container (->Container data)) produces the original data content
95 | and structure"
96 | [^Container container]
97 | {:pre [(instance? Container container)]}
98 | (let [item-ids (.getItemIds container)
99 | prop-ids (.getContainerPropertyIds container)]
100 | (if (or (empty? item-ids) (empty? prop-ids))
101 | (vec item-ids)
102 | (reduce (fn [data item-id]
103 | (conj data
104 | (persistent!
105 | (reduce #(assoc! %1 %2 (.getValue (.getContainerProperty container item-id %2)))
106 | (transient {})
107 | prop-ids))))
108 | []
109 | item-ids)
110 | )))
111 |
112 | (defn add-item-as-id [container last-id data]
113 | (.addItem container data)
114 | data)
115 |
116 | (defn add-item-gen-id [container last-id data]
117 | (let [id (inc last-id)
118 | row (if (collection? data) data [data])
119 | props (vec (.getContainerPropertyIds container))]
120 | (.addItem container id)
121 | (doseq [i (range 0 (count props))]
122 | (when (< i (count row))
123 | (.setValue (.getContainerProperty container id (props i)) (row i)))
124 | )
125 | id))
126 |
127 | (defmulti add-node (fn [container allow-children parent-id last-id child add-fn] (if (instance? Map child) :tree :leaf)))
128 |
129 | (declare add-tree)
130 |
131 | (defmethod add-node :leaf [container allow-children parent-id last-id child add-fn]
132 | (let [child-id (add-fn container last-id child)]
133 | (.setChildrenAllowed container child-id allow-children)
134 | (when parent-id
135 | (.setParent container child-id parent-id))
136 | child-id))
137 |
138 | (defmethod add-node :tree [container allow-children parent-id last-id child add-fn]
139 | (let [tree-parent (first (keys child))]
140 | (add-tree container allow-children parent-id last-id tree-parent (get child tree-parent) add-fn)))
141 |
142 | (defn add-tree [container allow-children parent-id last-id tree-parent children add-fn]
143 | {:pre [(not (instance? Map tree-parent)), (collection? children)]}
144 | (let [tree-parent-id (add-node container true parent-id last-id tree-parent add-fn)]
145 | (loop [remaining-children children
146 | last-id tree-parent-id]
147 | (if (empty? remaining-children)
148 | last-id
149 | (recur
150 | (rest remaining-children)
151 | (add-node container allow-children tree-parent-id last-id (first remaining-children) add-fn))))))
152 |
153 | (defn- choose-id-gen
154 | "Decide on the add method depending on the form of the data spec. Collection nodes use :gen-id, otherwise it's :add-id"
155 | [hdef]
156 | (if (or
157 | (empty? hdef)
158 | (collection? (first hdef))
159 | (and (instance? Map (first hdef)) (collection? (first (keys (first hdef))))))
160 | :gen-id
161 | :as-id))
162 |
163 | (defn add-hierarchy
164 | "Add data to a Container$Hierarchical. The data are (recursively) a Sequence of Maps, each Map defining a parent (the key)
165 | and the children (the value, another Sequence of Maps).
166 |
167 | add-as determines how items are added. :gen-id causes item ids to be generated, based on add index, :as-id uses the parent itself
168 | as the id. The former is generally used when adding to a container with item properties (such as a TreeTable), the later when the
169 | container only consideres the item ids themselves (as in a Tree). In the :gen-id case, keys and values are assumed to be Collections,
170 | and are mapped by index to the Container properties."
171 | ([container hdef allow-children add-as]
172 | (when-not (#{:gen-id :as-id} add-as)
173 | (bad-argument "Incorrect add specification: " add-as))
174 | (let [add-fn (if (= add-as :gen-id) add-item-gen-id add-item-as-id)]
175 | (loop
176 | [remaining-nodes hdef
177 | last-id -1]
178 | (if (empty? remaining-nodes)
179 | container
180 | (recur
181 | (rest remaining-nodes)
182 | (add-node container allow-children nil last-id (first remaining-nodes) add-fn))))))
183 | ([container hdef] (add-hierarchy container hdef false (choose-id-gen hdef)))
184 | )
185 |
186 | (defn ->Hierarchical [hdef]
187 | (add-hierarchy (HierarchicalContainer.) hdef))
188 |
--------------------------------------------------------------------------------
/src/functional_vaadin/event_handling.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.event-handling
9 | (:require [functional-vaadin.thread-vars :refer :all]
10 | [functional-vaadin.utils :refer :all])
11 | (:import (com.vaadin.ui Button$ClickListener Button$ClickEvent Button Panel Image Embedded Field Label
12 | Label$ValueChangeEvent AbstractTextField Table Table$HeaderClickListener Table$HeaderClickEvent
13 | Table$FooterClickListener Table$FooterClickEvent Upload Upload$ChangeListener Upload$ChangeEvent
14 | Upload$FailedListener Upload$FailedEvent Upload$FinishedEvent Upload$FinishedListener
15 | Upload$StartedListener Upload$StartedEvent Upload$SucceededListener Upload$SucceededEvent
16 | Upload$ProgressListener)
17 | (com.vaadin.event MouseEvents$ClickListener MouseEvents$ClickEvent FieldEvents$TextChangeListener
18 | FieldEvents$TextChangeEvent FieldEvents$TextChangeNotifier)
19 | (com.vaadin.data Property$ValueChangeListener Property$ValueChangeEvent Property$ValueChangeNotifier)))
20 |
21 | (defn- call-form-action [act-fn evt]
22 | (let [source (.getSource evt)]
23 | (act-fn source evt (get-field-group (form-of source)))))
24 |
25 | (defn call-action [act-fn evt]
26 | (act-fn (.getSource evt) evt))
27 |
28 | (defmulti onClick
29 | "Add a an action that occurs when the component is clicked"
30 | (fn [component action] (class component)))
31 |
32 | (defmethod onClick :default [component action]
33 | (unsupported-op "Click listeners on " (class component) " not yet supported"))
34 |
35 | (defmethod onClick Button [component act-fn]
36 | (.addClickListener
37 | component
38 | (reify
39 | Button$ClickListener
40 | (^void buttonClick [this ^Button$ClickEvent evt] (call-form-action act-fn evt))
41 | ))
42 | component)
43 |
44 | (defmethod onClick Panel [component act-fn]
45 | (.addClickListener
46 | component
47 | (reify
48 | MouseEvents$ClickListener
49 | (^void click [this ^MouseEvents$ClickEvent evt] (call-action act-fn evt))
50 | ))
51 | component)
52 |
53 | (defmethod onClick Image [component act-fn]
54 | (.addClickListener
55 | component
56 | (reify
57 | MouseEvents$ClickListener
58 | (^void click [this ^MouseEvents$ClickEvent evt] (call-action act-fn evt))
59 | ))
60 | component)
61 |
62 | (defmethod onClick Embedded [component act-fn]
63 | (.addClickListener
64 | component
65 | (reify
66 | MouseEvents$ClickListener
67 | (^void click [this ^MouseEvents$ClickEvent evt] (call-action act-fn evt))
68 | ))
69 | component)
70 |
71 | (defmulti onValueChange
72 | "Add a an action that occurs when a components vaue changes"
73 | (fn [component action] (class component)))
74 |
75 | (defmethod onValueChange :default [comp action]
76 | (unsupported-op "Value change listeners on " (class comp) "not yet supported"))
77 |
78 | (defmethod onValueChange Property$ValueChangeNotifier [component act-fn]
79 | (.addValueChangeListener
80 | component
81 | (reify
82 | Property$ValueChangeListener
83 | (^void valueChange [this ^Property$ValueChangeEvent evt] (call-action act-fn evt))
84 | ))
85 | component)
86 |
87 | (defmethod onValueChange Field [component act-fn]
88 | (.addValueChangeListener
89 | component
90 | (reify
91 | Property$ValueChangeListener
92 | (^void valueChange [this ^Property$ValueChangeEvent evt] (call-form-action act-fn evt))
93 | ))
94 | component)
95 |
96 | (defn onTextChange [^FieldEvents$TextChangeNotifier component act-fn]
97 | (.addTextChangeListener
98 | component
99 | (reify
100 | FieldEvents$TextChangeListener
101 | (^void textChange [this ^FieldEvents$TextChangeEvent evt] (call-form-action act-fn evt))
102 | ))
103 | component)
104 |
105 | (defn onHeaderClick [table act-fn]
106 | (.addHeaderClickListener
107 | table
108 | (reify
109 | Table$HeaderClickListener
110 | (^void headerClick [this ^Table$HeaderClickEvent evt]
111 | (act-fn (.getSource evt) evt (.getPropertyId evt)))
112 | ))
113 | table)
114 |
115 | (defn onFooterClick [table act-fn]
116 | (.addFooterClickListener
117 | table
118 | (reify
119 | Table$FooterClickListener
120 | (^void footerClick [this ^Table$FooterClickEvent evt]
121 | (act-fn (.getSource evt) evt (.getPropertyId evt)))
122 | ))
123 | table)
124 |
125 | ;; Upload events
126 |
127 | (defn onChange [^Upload upload act-fn]
128 | (.addChangeListener
129 | upload
130 | (reify
131 | Upload$ChangeListener
132 | (^void filenameChanged [this ^Upload$ChangeEvent evt]
133 | (act-fn (.getSource evt) evt (.getFilename evt))))))
134 |
135 | (defn onFailed [^Upload upload act-fn]
136 | (.addFailedListener
137 | upload
138 | (reify
139 | Upload$FailedListener
140 | (^void uploadFailed [this ^Upload$FailedEvent evt]
141 | (act-fn (.getSource evt) evt)))))
142 |
143 | (defn onFinished [^Upload upload act-fn]
144 | (.addFinishedListener
145 | upload
146 | (reify
147 | Upload$FinishedListener
148 | (^void uploadFinished [this ^Upload$FinishedEvent evt]
149 | (act-fn (.getSource evt) evt)))))
150 |
151 | (defn onStarted [^Upload upload act-fn]
152 | (.addStartedListener
153 | upload
154 | (reify
155 | Upload$StartedListener
156 | (^void uploadStarted [this ^Upload$StartedEvent evt]
157 | (act-fn (.getSource evt) evt)))))
158 |
159 | (defn onSucceeded [^Upload upload act-fn]
160 | (.addSucceededListener
161 | upload
162 | (reify
163 | Upload$SucceededListener
164 | (^void uploadSucceeded [this ^Upload$SucceededEvent evt]
165 | (act-fn (.getSource evt) evt)))))
166 |
167 | (defn onProgress [^Upload upload act-fn]
168 | (.addProgressListener
169 | upload
170 | (reify
171 | Upload$ProgressListener
172 | (^void updateProgress [this ^long readBytes ^long contentLength]
173 | (act-fn readBytes contentLength)))))
174 |
175 |
--------------------------------------------------------------------------------
/src/functional_vaadin/examples/Sampler.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 | (ns functional-vaadin.examples.Sampler
8 | "A simple UI that presents some UI examples in a TabSheet: a form and a table. progress bar, etc..
9 | The table can be filed by filling in the form and clicking 'Save'"
10 | (:use functional-vaadin.core
11 | functional-vaadin.actions
12 | functional-vaadin.data-binding
13 | functional-vaadin.event-handling
14 | functional-vaadin.rx.observers
15 | functional-vaadin.rx.operators
16 | functional-vaadin.examples.run
17 | )
18 | (:require [rx.lang.clojure.core :as rx])
19 | (:gen-class :name ^{com.vaadin.annotations.Theme "valo"} functional_vaadin.examples.Sampler
20 | :extends com.vaadin.ui.UI
21 | :main false)
22 | (:import (com.vaadin.ui Table UI Alignment Upload$Receiver Upload)
23 | (java.util.concurrent TimeUnit)
24 | (rx Observable)
25 | (java.io OutputStream ByteArrayOutputStream)))
26 |
27 | (defn- table-action-handler []
28 | (letfn [(select-fn [target table actions]
29 | (if (seq (.getValue table))
30 | (filter #(= (.getCaption %) "Delete Selected") actions)
31 | (filter #(= (.getCaption %) "Delete") actions)))]
32 | (->ActionHandler select-fn dispatch-listener
33 | [(->FunctionAction "Delete" (fn [a ^Table table id] (.removeItem table id)))
34 | (->FunctionAction "Delete Selected"
35 | (fn [a ^Table table id] (let [selected (.getValue table)]
36 | (if (seq selected)
37 | (doseq [id (seq selected)] (.removeItem table id ))
38 | (.removeItem table selected)))))])))
39 |
40 | (defn- form-and-table-tab []
41 | (vertical-layout {:caption "Form and Table" :sizeFull []}
42 | (horizontal-layout {:componentAlignment Alignment/TOP_CENTER}
43 | (form {:content (vertical-layout {:margin true :sizeUndefined []}) :id :form :margin true}
44 | (form-layout {:sizeUndefined []}
45 | (text-field {:bindTo ["first-name" String] :nullRepresentation "" :required true})
46 | (text-field {:bindTo ["last-name" String] :nullRepresentation "" :required true})
47 | (text-field {:bindTo ["notes" String] :nullRepresentation ""})
48 | )
49 | (horizontal-layout
50 | (button {:caption "Save" :id :save-button}))
51 | )
52 | (vertical-layout {:margin true :sizeUndefined [] :expandRatio 1.0}
53 | (table {:caption "People" :id :table
54 | :immediate true
55 | :selectable true :multiSelect true
56 | :actions (table-action-handler)
57 | }
58 | (table-column "first-name" {:header "First Name"})
59 | (table-column "last-name" {:header "Last Name"})
60 | (table-column "notes" {:header "Notes" :width 300})
61 | (table-column "loc" {:header "Location (Generated)" :width 210}
62 | (fn [t item col] (label (str "Item Id " item ", Column Id " col)))))
63 | (check-box {:id :edit-table :caption "Editable" :value false :alignment Alignment/MIDDLE_LEFT})
64 | )
65 | )
66 | )
67 | )
68 |
69 | (defn- background-task-tab []
70 | (vertical-layout {:caption "Background Task" :sizeFull []}
71 | (horizontal-layout {:margin true :spacing true :componentAlignment Alignment/TOP_CENTER}
72 | (button {:caption "Start" :id :start-button})
73 | (button {:caption "Stop" :id :stop-button :enabled false})
74 | (vertical-layout {:sizeUndefined []}
75 | (progress-bar {:id :progress :value (float 0.0) :width "300px"})
76 | (label {:value "Stopped" :id :running-state})))))
77 |
78 | (defn food-menu-tab []
79 | (vertical-layout {:caption "Food Menu" :margin true :spacing true :height "100%"}
80 | (horizontal-layout {:margin true :alignment Alignment/TOP_CENTER}
81 | (add-hierarchy (tree-table "Eats!"
82 | (table-column "Name" {:type String :defaultValue "" :width 200})
83 | (table-column "Number" {:type Long :defaultValue nil :width 100}))
84 | [{["Menu"]
85 | [{"Beverages"
86 | [["Coffee" 23]
87 | ["Tea" 42]]}
88 | {"Food"
89 | [["Bread" 13]
90 | ["Cake" 11]]}]}]
91 | ))))
92 |
93 | (defn file-upload-tab []
94 | (vertical-layout {:caption "File Upload" :width "100%"}
95 | (vertical-layout {:sizeUndefined [] :margin true :spacing true :componentAlignment Alignment/TOP_CENTER}
96 | (upload {:id :file-upload :receiver (reify
97 | Upload$Receiver
98 | (^OutputStream receiveUpload [this ^String fname ^String mineType]
99 | (ByteArrayOutputStream.)))})
100 | ;
101 | ; The current implementation of upload interrupt causes the upload to restart on Chrome and Firefox.
102 | ; Only Safari (AFAIK) has an implementation that works. Becaus of this, I've left out the Stop function,
103 | ; but left the code as an example. Feel free to uncomment (here and in setup-upload-actions) and experiment
104 |
105 | ;(button {:caption "Stop" :id :upload-stop-button :enabled false})
106 | (progress-bar {:id :upload-progress :value (float 0.0) :visible false :width "100%"})
107 | (label {:id :upload-state :value ""}))))
108 |
109 | (declare login-func)
110 |
111 | (defn login-form-tab []
112 | (vertical-layout {:caption "Login Forms" :margin true :spacing true :height "100%"}
113 | (vertical-layout {:sizeUndefined [] :margin [:top] :spacing true :componentAlignment Alignment/TOP_CENTER}
114 | (horizontal-layout {:spacing true }
115 | (panel {:caption "Default"} (login-form (fn [src evt uname pwd] (login-func uname pwd))))
116 | (panel {:caption "Modified"} (login-form
117 | {:usernameCaption "Enter username"
118 | :passwordCaption "And your password"
119 | :loginButtonFunc (fn [] (button "Do Login"))}
120 | (fn [src evt uname pwd] (login-func uname pwd)))))
121 | (label {:id :login-message}))))
122 |
123 | (defn- setup-form-actions [main-ui]
124 | (->> (button-clicks (componentNamed :save-button main-ui)) ; Observe Save button clicks
125 | (commit) ; Commit the form of which it is a part
126 | (consume-for (componentNamed :table main-ui) ; Consume the form data (in :item) and set into the table
127 | (fn [table data]
128 | (let [{:keys [item]} data
129 | row (object-array (map #(.getValue (.getItemProperty item %1)) ["first-name" "last-name" "notes"]))]
130 | (.addItem table row nil))
131 | )))
132 | (->> (value-changes (componentNamed :edit-table main-ui))
133 | (consume-for (componentNamed :table main-ui)
134 | (fn [table data]
135 | (.setEditable table (.getValue (:source data)))))))
136 |
137 | ;
138 | ; Simulate a background job for the progress indicator by using a timer to send events (increasing integers)
139 | ; at 1 second intervals. We update the progress by subscribing to these events.
140 | ;
141 |
142 | (defn- setup-background-actions [main-ui]
143 | (let [subscription (atom nil) ; Indicate we are running by saving the timer subsciption
144 | timer (->> ; The timer that sends events - wrap it in UI access protection
145 | (Observable/interval 100 TimeUnit/MILLISECONDS)
146 | (with-ui-access))
147 | progress (componentNamed :progress main-ui ) ; The progress bar component
148 | start-button (componentNamed :start-button main-ui) ; Start and stop button components
149 | stop-button (componentNamed :stop-button main-ui)
150 | state-label (componentNamed :running-state main-ui)
151 | stop-fn (fn [clickInfo] ; A function that stops the 'background' job
152 | (when @subscription ; When it's subscribed, timer is running, so unsubscribe and remove the subscription
153 | (swap! subscription (fn [s] (rx/unsubscribe s) nil))
154 | (.setValue progress (float 0.0)) ; Reset the progress bar, and flip button state
155 | (.setEnabled start-button true)
156 | (.setEnabled stop-button false)
157 | (.setValue state-label "Stopped")
158 | ))
159 | tick-fn (fn [t] ; Function to count the timer ticks
160 | (.setValue progress (float (/ (inc t) 100)))
161 | (if (> t 99) (stop-fn {}))) ;Stop when we're done
162 | start-fn (fn [clickInfo]
163 | (when-not @subscription ; When it's not subscribed, subscribe and save the subscription
164 | (swap! subscription (fn [_] (rx/subscribe timer tick-fn)))
165 | (.setEnabled start-button false) ; Flip button state so Start is disabled and Stop enabled
166 | (.setEnabled stop-button true)
167 | (.setValue state-label "Running...")
168 | ))
169 | ]
170 | (-> ; Set up the Start button to subscribe to the timer
171 | (button-clicks start-button)
172 | (rx/subscribe start-fn))
173 | (-> ; Set up the Stop button to stop the action
174 | (button-clicks stop-button)
175 | (rx/subscribe stop-fn))))
176 |
177 | (defn- set-label [label & args]
178 | (.setValue label (apply str args)))
179 |
180 | (defn setup-upload-actions [main-ui]
181 | (let [^Upload upload (componentNamed :file-upload main-ui)
182 | progress (componentNamed :upload-progress main-ui)
183 | ;stop-button (componentNamed :upload-stop-button main-ui)
184 | state-label (componentNamed :upload-state main-ui)]
185 | (onChange upload (fn [src evt fname]
186 | (.setVisible progress false)
187 | (set-label state-label "")))
188 | (onProgress upload (fn [readBytes contentLength]
189 | (set-label state-label "Upload " readBytes " bytes of " contentLength)
190 | (.setValue progress (float (/ readBytes contentLength)))))
191 | (onStarted upload (fn [c evt]
192 | ;(.setEnabled stop-button true)
193 | (.setVisible progress true)
194 | (set-label state-label "Uploading " (.getFilename evt) ", type " (.getMIMEType evt))))
195 | (onSucceeded upload (fn [c evt]
196 | (set-label state-label "Upload complete")
197 | ;(.setEnabled stop-button false)
198 | ))
199 | (onFailed upload (fn [c evt] (set-label state-label "Upload failed: " (.getMessage (.getReason evt)))))
200 | ;(onClick stop-button (fn [btn evt form]
201 | ; (set-label state-label "Interrupting...")
202 | ; (.setVisible progress false)
203 | ; (.interruptUpload upload)))
204 | ))
205 |
206 | (defn -init [^UI main-ui request]
207 | ; Define our UI. Use :id to capture components we'll need later
208 | (defui main-ui
209 | (panel {:caption "Functional Vaadin Sampler" :sizeFull []}
210 | (tab-sheet
211 | (form-and-table-tab)
212 | (background-task-tab)
213 | (food-menu-tab)
214 | (file-upload-tab)
215 | (login-form-tab)
216 | )
217 | )
218 | )
219 |
220 | (defn login-func [uname pwd]
221 | (.setValue (componentNamed :login-message main-ui) (str "Logged in as \"" uname "\" with password \"" pwd "\"")))
222 | (setup-form-actions main-ui)
223 | (setup-background-actions main-ui)
224 | (setup-upload-actions main-ui)
225 | (.setPollInterval main-ui 50) ; Make the ProgressBar work - we could also use PUSH mode
226 | )
227 |
--------------------------------------------------------------------------------
/src/functional_vaadin/examples/run.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 | (ns functional-vaadin.examples.run
8 | "A main function namespace to run examples in a jetty container"
9 | (:require [clojure.string :as str])
10 | (:import (org.eclipse.jetty.server Server)
11 | (org.eclipse.jetty.servlet ServletContextHandler)
12 | [com.vaadin.server VaadinServlet])
13 | (:gen-class))
14 |
15 | (defn- jetty-server [port ui-name]
16 | (doto (Server. port)
17 | (.setHandler
18 | (doto (ServletContextHandler. ServletContextHandler/SESSIONS)
19 | (.setContextPath "/")
20 |
21 | (.setInitParameter "UI" ui-name)
22 | (.setInitParameter "legacyPropertyToString" "true")
23 | (.setResourceBase "dev-resources/public")
24 | (.addServlet VaadinServlet "/*")))))
25 |
26 | (defn run-jetty [ui-name bg?]
27 | (let [server (jetty-server 8080 ui-name)]
28 | (.start server)
29 | (if bg?
30 | server
31 | (.join server))))
32 |
33 | (defn choose-example [examples]
34 | (loop []
35 | (doseq [f (map-indexed #(str (inc %1) ". " %2) examples)]
36 | (println " " f))
37 | (print "Choice? (Cntrl-C to exit) ") (flush)
38 | (let [item-number (dec (Integer/parseInt (read-line)))]
39 | (if (< item-number (count examples))
40 | (nth examples item-number)
41 | (recur))))
42 | )
43 |
44 | (defn run-example [name prompt]
45 | (println prompt)
46 | (run-jetty (str "functional_vaadin.examples." name ) true))
47 |
48 | (defn run-and-wait [name]
49 | (loop [server (run-example name (str "Running " name ". Type \"s\" to stop, \"r\" to restart"))]
50 | (let [response (.toLowerCase (read-line))]
51 | (cond
52 | (= response "s") (.stop server)
53 | (= response "r") (do
54 | (.stop server)
55 | (recur (run-example name "Restarting...")))
56 | :else (recur server)
57 | )))
58 | )
59 |
60 | (def examples ["Sampler"])
61 |
62 | (defn prompt-loop []
63 | (let [item (choose-example examples)]
64 | (run-and-wait item))
65 | (recur))
66 |
67 | (defn -main [& args]
68 | (if (zero? (count args))
69 | (prompt-loop)
70 | (run-and-wait (first args))))
71 |
72 |
--------------------------------------------------------------------------------
/src/functional_vaadin/naming.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.naming
9 | (:require [functional-vaadin.utils :refer :all])
10 | (:import (clojure.lang Keyword)
11 | (com.vaadin.ui Component)))
12 |
13 | (defn addComponent [ui ^Component component ^Keyword id]
14 | (let [ks (component-key id)]
15 | (if (get-data component ks)
16 | (bad-argument "There is already a component named " id))
17 | (attach-data ui ks component)))
18 |
19 | (defn componentAt [ui ^Keyword id]
20 | (get-data ui (component-key id)))
21 |
22 |
23 |
--------------------------------------------------------------------------------
/src/functional_vaadin/rx/observers.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 | (ns functional-vaadin.rx.observers
8 | "Reactive extensions to interface with RxClojure. These are functions to generate Observables from various Vaadin events."
9 | (:require [functional-vaadin.event-handling :refer :all]
10 | [functional-vaadin.utils :refer :all]
11 | [rx.lang.clojure.core :as rx])
12 | (:import (rx Subscriber Observable)
13 | (com.vaadin.ui AbstractTextField)
14 | (com.vaadin.event Action$Listener ShortcutAction)))
15 |
16 | (defn button-clicks
17 | "Observe button clicks for the given button. Returns the Observable. Subscribers will receive a Map
18 | {:source btn :event evt :field-group fg} where source is the source of the click (the btn), event is the ClickEvent
19 | and fg is the Fieldgroup of the form that the btn is on, or nil if there is no form"
20 | [btn]
21 | (rx/observable*
22 | (fn [^Subscriber sub]
23 | (onClick btn (fn [source evt fg]
24 | (.onNext sub {:source source :event evt :field-group fg}))))))
25 |
26 | (defn value-changes
27 | "Observe value changes for the given notifier. Returns the Observable. Subscribers will receive a Map
28 | {:source notifier :event evt :field-group fg} where source is the source of the click (the notifier), event is the ValueChangeEvent
29 | and fg is the Fieldgroup of the form that the notifier is on, or nil if there is no form."
30 | [notifier]
31 | (rx/observable*
32 | (fn [^Subscriber sub]
33 | (onValueChange notifier
34 | (fn
35 | ([source evt] (.onNext sub {:source source :event evt}))
36 | ([source evt fg] (.onNext sub {:source source :event evt :field-group fg})))))))
37 |
38 | (defn mouse-clicks
39 | "Observe value changes for the given notifier. Returns the Observable. Subscribers will receive a Map
40 | {:source notifier :event evt} where source is the source of the click (the notifier) and event is the MouseClickEvent."
41 | [component]
42 | (rx/observable*
43 | (fn [^Subscriber sub] (onClick component (fn [s evt fg] (.onNext sub {:source s :event evt}))))))
44 |
45 | (defn text-changes
46 | "Observe text changes for the given notifier. Returns the Observable. Subscribers will receive a Map
47 | {:source textField :event evt} where source is the source of the click (the textField) and event is the TextChangeEvent."
48 | [textField]
49 | (rx/observable*
50 | (fn [^Subscriber sub] (onTextChange textField (fn [s evt fg] (.onNext sub {:source s :event evt}))))))
51 |
52 | (defn events-in
53 | "Observe events from a function. On subscription, act-fn is executed asynchronously in a future and passed the subscriber (s)
54 | and any extra args provided. Events are indicated by using (rx/on-next s) within the function. (rx/on-completed s) is sent when the
55 | function completes, and any exceptions thrown are reported with (rx/on-error s e). The function should check for unsuncribes, and
56 | act appropriately (usually terminating)."
57 | [act-fn & args]
58 | (rx/observable* (fn [^rx.Subscriber s]
59 | (future
60 | (try
61 | (apply act-fn (concat (list s) args))
62 | (when-subscribed (.onCompleted s))
63 | (catch Throwable e
64 | (when-subscribed (.onError s e))))))))
65 |
66 | (defn- event-shortcut
67 | [{:keys [name keycode modifiers]} a-fn]
68 | (proxy [ShortcutAction Action$Listener] [name (int keycode) (int-array (or modifiers []))]
69 | (handleAction [sender target] (a-fn this sender target)))
70 | )
71 |
72 | (defn with-action-events
73 | "Add a set of shortcut actions to a Panel or Window, and generate events that track their activation. Actions are a
74 | list of action specs, which are Maps with keys :name and :keycode. These specify the action and keycode for eact action.
75 |
76 | On activation, sunscribers will receive a value that is a Map of :action, :sender and :target keys. These are as passed
77 | to the handleAction method of the Action.Listener interface."
78 | [component actions]
79 | (rx/observable*
80 | (fn [^rx.Subscriber o]
81 | (doseq [action actions]
82 | (.addAction component
83 | (event-shortcut action (fn [a s t] (when-subscribed o (.onNext o {:action a :sender s :target t})))))))))
84 |
85 | (defn header-clicks
86 | "Generate events from mouse clicks in a table header. Subscribers will receive a value that is a Map with keys
87 | :source :event :propertyId"
88 | [table]
89 | (rx/observable*
90 | (fn [^Subscriber sub]
91 | (onHeaderClick table
92 | (fn [source evt propertyId]
93 | (.onNext sub {:source source :event evt :propertyId propertyId})))))
94 | )
95 |
96 | (defn footer-clicks
97 | "Generate events from mouse clicks in a table header. Subscribers will receive a value that is a Map with keys
98 | :source :event :propertyId"
99 | [table]
100 | (rx/observable*
101 | (fn [^Subscriber sub]
102 | (onFooterClick table
103 | (fn [source evt propertyId]
104 | (.onNext sub {:source source :event evt :properyId propertyId})))))
105 | )
106 |
107 | ; TODO - other observers - component clicks - see notes.
108 |
109 |
110 |
--------------------------------------------------------------------------------
/src/functional_vaadin/rx/operators.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 | (ns functional-vaadin.rx.operators
8 | "Useful operators to transform streams from Vaadin component observables"
9 | (:require [functional-vaadin.core :refer :all]
10 | [functional-vaadin.utils :refer :all]
11 | [rx.lang.clojure.core :as rx])
12 | (:import (rx Observable Observer)
13 | (com.vaadin.data.fieldgroup FieldGroup FieldGroup$FieldGroupInvalidValueException FieldGroup$CommitException)
14 | (java.util Map)
15 | (com.vaadin.ui UI Window)
16 | (com.vaadin.server ErrorHandlingRunnable)
17 | (com.vaadin.data Validator$EmptyValueException)))
18 |
19 | (defn consume-for
20 | "Usage: (consume-for component fn xs)
21 |
22 | Subscribes to an Observable xs, calling the function fn with the given component for every event received
23 | from xs."
24 | [comp c-fn xs]
25 | (let [c comp]
26 | (rx/subscribe xs
27 | (fn [v] (c-fn c v))
28 | (fn [e])
29 | (fn [])))
30 | )
31 |
32 | (defn- failure-message [e]
33 | (if (instance? Validator$EmptyValueException e)
34 | "Required"
35 | (.getMessage e)))
36 |
37 | (defn- default-commit-error-handler [e]
38 | (if (instance? FieldGroup$CommitException e)
39 | (.center
40 | (window "Field Errors"
41 | (apply vertical-layout
42 | (concat (list {:margin true :spacing true})
43 | (map
44 | (fn [[f exp]]
45 | (label (str (.getCaption f) ": " (failure-message exp))))
46 | (.getInvalidFields e))))))
47 | (throw e))
48 | )
49 |
50 | (defn- do-commit [v]
51 | (condp instance? v
52 | Map (if-let [fg (:field-group v)]
53 | (do
54 | (.commit fg)
55 | (assoc v :item (.getItemDataSource fg))) ; Add the data Item to the Map
56 | )
57 | FieldGroup (do
58 | (.commit v)
59 | (.getItemDataSource v))
60 | ; default - pass the item through
61 | v))
62 |
63 | (defn commit
64 | "Usage: (commit error-handler? xs)
65 |
66 | Commit a received event from a form item by calling commit on the forms field group and extracting the data as an item. The item
67 | is passed on to the next subscriber. Assumes it will receive either a single FieldGroup object, or a Map with
68 | containing a key :field-group. For the former, just the item data is passed on, in the latter case, the data is added
69 | to the Map under a key :item. Simply passes on the received data if there is no field group."
70 | ([commit-error-handler ^Observable xs]
71 | (let [op (rx/operator*
72 | (fn [subscribed-o]
73 | (rx/subscriber subscribed-o
74 | (fn [^Observer recv-o v]
75 | (when-subscribed recv-o
76 | (try
77 | (.onNext recv-o (do-commit v))
78 | (catch FieldGroup$CommitException e
79 | (commit-error-handler e))
80 | (catch Throwable t
81 | (.onError recv-o t)))))
82 | (fn [recv-o e]
83 | (when-subscribed recv-o
84 | (.onError recv-o e)))
85 | )
86 | ))]
87 | (rx/lift op xs)))
88 | ([^Observable xs] (commit default-commit-error-handler xs))
89 | )
90 |
91 | (defn with-ui-access
92 | "Usage: (with-ui-access xs)
93 |
94 | Forward events to subscribers protected by a UI access lock. Uses UI.access() which hands the onNext off to a Future."
95 | [^Observable xs]
96 | (let [op (rx/operator*
97 | (fn [subscribed-o]
98 | (rx/subscriber subscribed-o
99 | (fn [recv-o v] ;on-next
100 | (when-subscribed recv-o
101 | (if-let [ui (UI/getCurrent)]
102 | (.access ui
103 | (reify
104 | ErrorHandlingRunnable
105 | (^void run [this] (rx/on-next recv-o v))
106 | (^void handleError [this ^Exception e] (rx/on-error recv-o e))))
107 | (try
108 | (rx/on-next recv-o v)
109 | (catch Exception e
110 | (rx/on-error recv-o e)))
111 | )))
112 | (fn [recv-o e]
113 | (when-subscribed recv-o
114 | (rx/on-error recv-o e))))
115 | ))]
116 | (rx/lift op xs)))
117 |
--------------------------------------------------------------------------------
/src/functional_vaadin/thread_vars.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.thread-vars
9 | (:import [com.vaadin.data.fieldgroup FieldGroup]))
10 |
11 | ; TODO - replace with (UI/getCurrent) ?
12 | (def
13 | ^{:dynamic true}
14 | *current-ui*
15 | "A dynamic var that will hold the current ui during building" nil)
16 |
17 | (def
18 | ^{:dynamic true :tag FieldGroup}
19 | *current-field-group*
20 | "A dynamic var that holds the field group of any form being built" nil)
--------------------------------------------------------------------------------
/src/functional_vaadin/ui/LoginForm.clj:
--------------------------------------------------------------------------------
1 | (ns functional-vaadin.ui.LoginForm
2 | (:gen-class :name functional_vaadin.ui.LoginForm
3 | :extends com.vaadin.ui.LoginForm
4 | :main false
5 | :state state
6 | :init init-my-state
7 | :methods [
8 | [setLoginButtonFunc [clojure.lang.IFn] void]
9 | [setUsernameFieldFunc [clojure.lang.IFn] void]
10 | [setPasswordFieldFunc [clojure.lang.IFn] void]
11 | ]
12 | :exposes-methods {createLoginButton superCreateLoginButton
13 | createUsernameField superCreateUsernameField
14 | createPasswordField superCreatePasswordField}))
15 |
16 | (defn -init-my-state []
17 | [[] (atom {})])
18 |
19 | (defn- setState [state key value]
20 | (swap! state #(assoc % key value)))
21 |
22 | (defn- get-state [state key]
23 | (get @state key))
24 |
25 | (defn -setLoginButtonFunc [this func]
26 | (setState (.state this) :loginButtonFunc func))
27 |
28 | (defn -setUsernameFieldFunc [this func]
29 | (setState (.state this) :usernameFieldFunc func))
30 |
31 | (defn -setPasswordFieldFunc [this func]
32 | (setState (.state this) :passwordFieldFunc func))
33 |
34 | (defn -createLoginButton [this]
35 | (if-let [func (get-state (.state this) :loginButtonFunc)]
36 | (func)
37 | (.superCreateLoginButton this)))
38 |
39 | (defn -createUsernameField [this]
40 | (if-let [func (get-state (.state this) :usernameFieldFunc)]
41 | (func)
42 | (.superCreateUsernameField this)))
43 |
44 | (defn -createPasswordField [this]
45 | (if-let [func (get-state (.state this) :passwordFieldFunc)]
46 | (func)
47 | (.superCreatePasswordField this)))
48 |
49 |
--------------------------------------------------------------------------------
/src/functional_vaadin/utils.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.utils
9 | "Generally useful utility functions"
10 | (:require [clojure.string :as str]
11 | [rx.lang.clojure.core :as rx])
12 | (:import (com.vaadin.ui AbstractComponent)
13 | (java.util Collection)))
14 |
15 | (defn capitalize [s]
16 | (if (empty? s) s (str (.toUpperCase (subs s 0 1)) (subs s 1))))
17 |
18 | (defn uncapitalize [s]
19 | (if (empty? s) s (str (.toLowerCase (subs s 0 1)) (subs s 1))))
20 |
21 | (defn parse-key [key]
22 | (cond
23 | (string? key) (map keyword (str/split key #"\."))
24 | (keyword? key) (map keyword (str/split (name key) #"\."))
25 | (or (seq? key) (vector? key)) (map keyword key)
26 | )
27 | )
28 |
29 | (defn component-key [id]
30 | (concat [:components] (parse-key id)))
31 |
32 | (defn binding-key [id]
33 | (concat [:bindings] (parse-key id)))
34 |
35 | (defn attach-data
36 | "Attach data to a Component indexed by a key. The data is stored in a Map under the key, which is in turn
37 | stored in the setData() attribute of the Component"
38 | [^AbstractComponent component key data]
39 | (.setData component (assoc-in (.getData component) (parse-key key) data)))
40 |
41 | (defn get-data
42 | "Get any attached data at key"
43 | [component key]
44 | (get-in (.getData component) (parse-key key)))
45 |
46 | (defn detach-data
47 | "Get and remove any attached data at key"
48 | [component key]
49 | (let [ks (parse-key key)
50 | ret (get-data component ks)]
51 | (.setData
52 | component
53 | (cond
54 | (= 1 (count ks)) (dissoc (.getData component) (first ks))
55 | :else (let [front (take (dec (count ks)) ks)
56 | last (last ks)]
57 | (update-in (.getData component) front #(dissoc %1 last)))
58 | ))
59 | ret))
60 |
61 | (defn humanize
62 | "Turn a keyword or symbol string into a humanized for. The text is split at hyphens (-) and each segment is capitalized"
63 | [kw-or-string]
64 | (str/join " " (map capitalize (str/split (name kw-or-string) #"-"))))
65 |
66 | (defn extract-keys
67 | "Extract the keys and values from m whose keys appear in rmkeys. Return the extracted map and the remaining map"
68 | [m rmkeys]
69 | (reduce (fn [[l r] k]
70 | (if ((set (keys r)) k)
71 | [(assoc l k (get r k)) (dissoc r k)]
72 | [l r]))
73 | [{} m] rmkeys)
74 | )
75 |
76 | (defn get-field-group [component]
77 | (and component (get-data component :field-group)))
78 |
79 | (defn set-field-group [component fg]
80 | {:pre [(not (nil? component))]}
81 | (attach-data component :field-group fg))
82 |
83 | (defn form-of
84 | "Return the form the component is a member of. Defined as the first parent component with a field group."
85 | [component]
86 | (if component
87 | (if (get-field-group component)
88 | component
89 | (recur (.getParent component)))))
90 |
91 | (defn iterable? [obj]
92 | (instance? Iterable obj))
93 |
94 | (defn collection? [obj]
95 | (instance? Collection obj))
96 |
97 | (defn not-of-type
98 | "True if val is an instance of one of the types in type list"
99 | [val type-list]
100 | (every? #(not (instance? %1 val)) type-list))
101 |
102 | (defn bad-argument [& args]
103 | (throw (IllegalArgumentException. ^String (apply str args))))
104 |
105 | (defn unsupported-op [& args]
106 | (throw (UnsupportedOperationException. ^String (apply str args))))
107 |
108 | (defmacro when-subscribed [o & body]
109 | `(when-not (rx/unsubscribed? ~o)
110 | ~@body))
111 |
--------------------------------------------------------------------------------
/src/functional_vaadin/validation.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.validation
9 | "Interface to Vaadin validators and definition of a configurable, function-base validator"
10 | (:require [clojure.string :as str]
11 | [functional-vaadin.utils :refer :all])
12 | (:import (com.vaadin.data Validator Validator$InvalidValueException)))
13 |
14 | (deftype FunctionalValidator [v-fn error-message]
15 | Validator
16 | (validate [this obj]
17 | (when-not (v-fn obj)
18 | (throw
19 | (Validator$InvalidValueException. (str/replace error-message "{0}" (str obj))))))
20 | )
21 |
22 |
--------------------------------------------------------------------------------
/test/functional_vaadin/actions_test.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.actions-test
9 | (:use [clojure.test]
10 | [functional-vaadin.actions]
11 | )
12 | (:import (com.vaadin.event ShortcutAction ShortcutAction$KeyCode Action Action$Listener Action$Handler)
13 | (com.vaadin.server FileResource)
14 | (java.io File)
15 | (functional_vaadin.actions ActionHandler)))
16 |
17 | (deftest creation-fns
18 | (testing "ShortcutActions"
19 | (let [result (atom nil)
20 | a (->ShortcutAction "Enter" ShortcutAction$KeyCode/ENTER (fn [a s t] (swap! result (fn [_] [a s t]))))]
21 | (is (instance? ShortcutAction a))
22 | (is (instance? Action$Listener a))
23 | (is (= (.getCaption a) "Enter"))
24 | (is (not (.getIcon a)))
25 | (is (= (.getKeyCode a) ShortcutAction$KeyCode/ENTER))
26 | (do
27 | (.handleAction a "Sender" "Target")
28 | (is (= @result [a "Sender" "Target"])))
29 | )
30 | (let [result (atom nil)
31 | icon (FileResource. (File. "icon"))
32 | a (->ShortcutAction ["Enter" icon] ShortcutAction$KeyCode/ENTER (fn [a s t] (swap! result (fn [_] [a s t]))))]
33 | (is (instance? ShortcutAction a))
34 | (is (instance? Action$Listener a))
35 | (is (= (.getCaption a) "Enter"))
36 | (is (= (.getIcon a) icon))
37 | (is (= (.getKeyCode a) ShortcutAction$KeyCode/ENTER))
38 | (do
39 | (.handleAction a "Sender" "Target")
40 | (is (= @result [a "Sender" "Target"])))
41 | )
42 | )
43 | (testing "Actions"
44 | (let [result (atom nil)
45 | icon (FileResource. (File. "icon"))
46 | a (->FunctionAction "Mark" icon (fn [a s t] (swap! result (fn [_] [a s t]))))]
47 | (is (instance? Action a))
48 | (is (instance? Action$Listener a))
49 | (is (= (.getCaption a) "Mark"))
50 | (is (= (.getIcon a) icon))
51 | (do
52 | (.handleAction a "Sender" "Target")
53 | (is (= @result [a "Sender" "Target"])))
54 | ))
55 | (testing "ActionHandler"
56 | (let [result (atom nil)
57 | icon (FileResource. (File. "icon"))
58 | actions (map #(->FunctionAction (str "Action " %1) icon (fn [a s t] (swap! result (fn [_] [a s t])))) (range 10))
59 | ah (->ActionHandler all-actions dispatch-listener actions)]
60 | (is (instance? ActionHandler ah))
61 | (is (instance? Action$Handler ah))
62 | (is (= (seq (.getActions ah "Target" "Sender")) actions))
63 | (let [a (first (.getActions ah "Target" "Sender"))]
64 | (.handleAction a "Sender" "Target")
65 | (is (= @result [a "Sender" "Target"])))
66 | ))
67 | )
--------------------------------------------------------------------------------
/test/functional_vaadin/build_support_test.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.build-support-test
9 | (:require [clojure.spec.alpha :as s])
10 | (:use [clojure.test]
11 | [functional-vaadin.build-support]
12 | [functional-vaadin.utils])
13 | (:import (com.vaadin.ui Button VerticalLayout Panel Label GridLayout Table)
14 | (com.vaadin.server Resource ClassResource FileResource)
15 | (clojure.lang MapEntry)
16 | (java.io File)))
17 |
18 | (deftest component-args-spec
19 | (testing "conformance"
20 | (is (= (s/conform ::functional-vaadin.build-support/component-args '())
21 | {}))
22 | (is (= (s/conform ::functional-vaadin.build-support/component-args [{:hidden true}])
23 | {:config {:hidden true}}))
24 | (is (= (s/conform ::functional-vaadin.build-support/component-args '("c1" "c2"))
25 | {:initial-args ["c1" "c2"]}))
26 | (is (= (s/conform ::functional-vaadin.build-support/component-args '("c1" "c2" {:hidden true}))
27 | {:initial-args ["c1" "c2"] :config {:hidden true}}))
28 |
29 | ; Test component children
30 | (let [c1 (Button.)
31 | c2 (VerticalLayout.)]
32 | (is (= (s/conform ::functional-vaadin.build-support/component-args (list {:hidden true} c1 c2))
33 | {:config {:hidden true} :children [c1 c2]}))
34 | (is (= (s/conform ::functional-vaadin.build-support/component-args (list "c1" c1 {:hidden true} c1 c2))
35 | {:initial-args ["c1" c1] :config {:hidden true} :children [c1 c2]})))
36 |
37 | ; Test table column children
38 | (let [c1 (->TableColumn "first-name" {:header "First Name" })
39 | c2 (->TableColumn "last-name" {:header "Last Name" })]
40 | (is (= (s/conform ::functional-vaadin.build-support/component-args (list {:caption "Table"} c1 c2))
41 | {:config {:caption "Table"} :children [c1 c2]}))
42 | (is (= (s/conform ::functional-vaadin.build-support/component-args (list "c1" c1 {:caption "Table"} c1 c2))
43 | {:initial-args ["c1" c1] :config {:caption "Table"} :children [c1 c2]})))
44 | )
45 | (testing "failed conformance"
46 | (is (= (s/conform ::functional-vaadin.build-support/component-args [{:hidden true} {:enabled false}])
47 | ::s/invalid))
48 | (let [c1 (Button.)
49 | c2 (VerticalLayout.)]
50 | (is (= (s/conform ::functional-vaadin.build-support/component-args ["c1" {:hidden true} {:enabled false} c1])
51 | ::s/invalid))))
52 | )
53 |
54 | (deftest menu-item-spec
55 | (testing "fn spec"
56 | (let [icon (FileResource. (File. "fname"))
57 | ispec1 (->MenuItemSpec "sub1" nil identity)
58 | ispec2 (->MenuItemSpec "sub2" nil identity)]
59 | (is (=
60 | (s/conform ::functional-vaadin.build-support/menu-item-args (list "item" identity))
61 | {:name "item" :children (MapEntry. :item_fn identity)}))
62 | (is (=
63 | (s/conform ::functional-vaadin.build-support/menu-item-args (list "item" icon identity))
64 | {:name "item" :icon_resource icon :children (MapEntry. :item_fn identity)}))
65 | (is (=
66 | (s/conform ::functional-vaadin.build-support/menu-item-args (list "item" ispec1 ispec2))
67 | {:name "item" :children (MapEntry. :sub_items [ispec1 ispec2])}))
68 | (is (=
69 | (s/conform ::functional-vaadin.build-support/menu-item-args (list "item"))
70 | ::s/invalid)))
71 | ))
72 |
73 | (deftest new-instance
74 |
75 | (testing "Ctor choosing"
76 | (doseq [args [
77 | (list "Caption")
78 | (list (ClassResource. "file"))
79 | (list "Caption" (ClassResource. "file"))
80 | (list {:caption "Caption"})
81 | (list "Caption" {:icon (ClassResource. "file")})
82 | ]
83 | ]
84 | (let [[b c] (create-widget Button args false)]
85 | (is (instance? Button b))
86 | (is (= c '()))
87 | (is (= (if (instance? Resource (first args)) nil "Caption") (.getCaption b)))))
88 | (let [[b c] (create-widget Button () false)]
89 | (is (instance? Button b))
90 | (is (= c '())))
91 | (is (thrown-with-msg? IllegalArgumentException #"Cannot create a Button from \[1 2\]"
92 | (create-widget Button '(1 2) false)))
93 | (doseq [args [
94 | (list (VerticalLayout.) (Label. "a") (Label. "b"))
95 | (list "Caption" (VerticalLayout.) (Label. "a") (Label. "b"))
96 | (list {:caption "Caption" :content (VerticalLayout.)} (Label. "a") (Label. "b"))
97 | ]
98 | ]
99 | (let [[b c] (create-widget Panel args true)]
100 | (is (instance? Panel b))
101 | (is (collection? c))
102 | (is (= 2 (count c)))
103 | (is (every? #(instance? Label %1) c))
104 | (is (= ["a" "b"] (map (fn [it] (.getValue it)) c)))
105 | (is (= (if (and (instance? VerticalLayout (first args)) (= 3 (count args))) nil "Caption" ) (.getCaption b)))))
106 |
107 | (doseq [args [
108 | (list 1 1 (Label. "Cell 1-1"))
109 | ]
110 | ]
111 | (let [[b c] (create-widget GridLayout args true)]
112 | (is (instance? GridLayout b))
113 | (is (= 1 (count c))))))
114 |
115 | )
116 |
117 |
118 |
--------------------------------------------------------------------------------
/test/functional_vaadin/config_test.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.config-test
9 | (:require [clojure.spec.alpha :as s])
10 | (:use [clojure.test]
11 | [functional-vaadin.core]
12 | [functional-vaadin.actions]
13 | [functional-vaadin.validation]
14 | [functional-vaadin.naming]
15 | [functional-vaadin.thread-vars]
16 | [functional-vaadin.config]
17 | [functional-vaadin.utils]
18 | )
19 |
20 | (:import (com.vaadin.ui Button VerticalLayout Alignment TextField Label)
21 | (com.vaadin.shared.ui MarginInfo)
22 | (com.vaadin.server Sizeable)
23 | (java.util Map)
24 | (functional_vaadin.ui TestUI)
25 | (com.vaadin.data.util PropertysetItem)
26 | (com.vaadin.data.fieldgroup FieldGroup)
27 | (com.vaadin.data.validator StringLengthValidator)
28 | (functional_vaadin.validation FunctionalValidator)
29 | (functional_vaadin.ui LoginForm)
30 | (com.vaadin.event ActionManager Action$Handler Action$Listener)))
31 |
32 | (defmacro with-form [& forms]
33 | `(with-bindings
34 | {#'*current-field-group* (FieldGroup. (PropertysetItem.))}
35 | ~@forms
36 | *current-field-group*))
37 |
38 | (deftest configuration
39 |
40 | (testing "Zero option args"
41 | (let [obj (vertical-layout {:sizeFull nil})]
42 | (is (= (.getWidth obj) 100.0))
43 | (is (= (.getHeight obj) 100.0))))
44 |
45 | (testing "Single option args"
46 | (let [obj (Button.)]
47 | (is (identical? (configure obj {:caption "Caption"}) obj))
48 | (is (= (.getCaption (configure obj {:caption "Caption2"})) "Caption2"))
49 | (is (= (.getCaption (configure obj {:caption ["Caption3"]})) "Caption3"))
50 | (is (= (.getHeight (configure obj {:height "3px"})) 3.0))
51 | (is (= (.getHeight (configure obj {:height ["3px"]})) 3.0)))
52 |
53 | (let [obj (configure (VerticalLayout.) {:margin true :spacing true })]
54 | (is (.isSpacing obj))
55 | (is (= (.getMargin obj) (MarginInfo. true true true true)))))
56 |
57 | (testing "Multiple option args"
58 | (let [obj (Button.)]
59 | (is (= (.getHeight (configure obj {:height [3 (Sizeable/UNITS_INCH)]})) 3.0))
60 | (is (= (.getHeightUnits (configure obj {:height [3 (Sizeable/UNITS_INCH)]})) (Sizeable/UNITS_INCH))))
61 |
62 | (let [obj (configure (Button.) {:height [3 (Sizeable/UNITS_MM)] :width [4 (Sizeable/UNITS_MM)]})]
63 | (is (= (.getHeight obj) 3.0))
64 | (is (= (.getHeightUnits obj) (Sizeable/UNITS_MM)))
65 | (is (= (.getWidth obj) 4.0))
66 | (is (= (.getWidthUnits obj) (Sizeable/UNITS_MM)))
67 | ))
68 |
69 | (testing "Parent attributes"
70 | )
71 |
72 | (testing "Synthetic attributes"
73 | (with-bindings
74 | {#'*current-ui* (TestUI.)}
75 | (let [b (button {:id "myform"})]
76 | (is (= (.getId b) "myform"))
77 | (is (identical? (componentAt *current-ui* :myform) b))
78 | ))
79 | (with-bindings
80 | {#'*current-ui* (TestUI.)}
81 | (let [b (button {:id :myform.save})]
82 | (is (= (.getId b) "myform.save"))
83 | (is (identical? (componentAt *current-ui* :myform.save) b))
84 | ))
85 | (let [b (button {:position [0 0]})]
86 | (is (= (.getData b) {:parent-data {:position [0 0]}})))
87 | (let [b (button {:alignment Alignment/TOP_LEFT})]
88 | (is (= (.getData b) {:parent-data {:componentAlignment [b Alignment/TOP_LEFT]}}))
89 | )
90 | (button {:addStyleName "border"}) ;How to verify ?
91 |
92 | (let [f (text-field {:validateWith (StringLengthValidator. "Length Error: {0}")})]
93 | (is (= 1 (count (.getValidators f))))
94 | (is (instance? StringLengthValidator (first (.getValidators f)))))
95 |
96 | (let [f (text-field {:validateWith [
97 | (StringLengthValidator. "Length Error: {0}")
98 | (->FunctionalValidator (fn [obj] false) "Always fail {0}")]})]
99 | (is (= 2 (count (.getValidators f))))
100 | (is (= [StringLengthValidator FunctionalValidator] (map #(class %1) (.getValidators f)))))
101 | )
102 |
103 | (testing "Actions"
104 | (is (instance? Action$Handler (->ActionHandler all-actions dispatch-listener
105 | [(->FunctionAction "Action" (fn [a s t] ))])))
106 | (is (instance? Action$Listener (->FunctionAction "Action" (fn [a s t] ))))
107 | (is (every? #(instance? Action$Listener %)
108 | (map
109 | #(->FunctionAction (str "Action" %) (fn [a s t]))
110 | (range 5))))
111 | (let [results (atom nil)
112 | actions (map
113 | #(->FunctionAction (str "Action" %) (fn [a s t] (swap! results (fn [_] [a s t]))))
114 | (range 5))
115 | ^ActionManager am (action-manager {:actions actions})
116 | ]
117 | (is (= (seq (.getActions am "Target" "Sender")) actions))
118 | (let [a (first (.getActions am "Target" "Sender"))]
119 | (.handleAction a "Sender" "Target")
120 | (is (= @results [a "Sender" "Target"])))
121 | )
122 | (let [results (atom nil)
123 | actions (map
124 | #(->FunctionAction (str "Action" %) (fn [a s t] (swap! results (fn [_] [a s t]))))
125 | (range 5))
126 | ^ActionManager am (action-manager {:actions (->ActionHandler all-actions dispatch-listener actions)})
127 | ]
128 | (is (= (seq (.getActions am "Target" "Sender")) actions))
129 | (let [a (first (.getActions am "Target" "Sender"))]
130 | (.handleAction a "Sender" "Target")
131 | (is (= @results [a "Sender" "Target"]))))
132 | (let [results (atom nil)
133 | actions (vec (map
134 | #(->FunctionAction (str "Action" %) (fn [a s t] (swap! results (fn [_] [a s t]))))
135 | (range 5)))
136 | ^ActionManager am (action-manager {:actions (->ActionHandler all-actions dispatch-listener actions)})
137 | ]
138 | (is (= (seq (.getActions am "Target" "Sender")) actions))
139 | (let [a (first (.getActions am "Target" "Sender"))]
140 | (.handleAction a "Sender" "Target")
141 | (is (= @results [a "Sender" "Target"]))))
142 | )
143 |
144 | (testing "Binding"
145 | (let [fg (with-form
146 | (bind-field (TextField.) "propId"))
147 | item (.getItemDataSource fg)]
148 | (is (= (set (.getItemPropertyIds item)) #{"propId"}))
149 | (is (identical? (.getType (.getItemProperty item "propId")) Object))
150 | (is (nil? (.getValue (.getItemProperty item "propId"))))
151 | )
152 | (doseq [bval [["propId" String]
153 | {:propertyId "propId" :type String}]]
154 | (let [fg (with-form
155 | (bind-field (TextField.) bval))
156 | item (.getItemDataSource fg)]
157 | (is (= (set (.getItemPropertyIds item)) #{"propId"}))
158 | (is (identical? (.getType (.getItemProperty item "propId")) String))
159 | (is (nil? (.getValue (.getItemProperty item "propId"))))
160 | ))
161 | (doseq [bval [["propId" String "text"]
162 | {:propertyId "propId" :type String :initialValue "text"}]]
163 | (let [fg (with-form
164 | (bind-field (TextField.) bval))
165 | item (.getItemDataSource fg)]
166 | (is (= (set (.getItemPropertyIds item)) #{"propId"}))
167 | (is (identical? (.getType (.getItemProperty item "propId")) String))
168 | (is (= (.getValue (.getItemProperty item "propId")) "text"))
169 | ))
170 |
171 | )
172 |
173 | (testing "Margin setting"
174 | (let [l (vertical-layout {:margin true})]
175 | (is (= (.getMargin l) (MarginInfo. true ))))
176 | (let [l (vertical-layout {:margin [:vertical]})]
177 | (is (= (.getMargin l) (MarginInfo. true false))))
178 | (let [l (vertical-layout {:margin [:horizontal]})]
179 | (is (= (.getMargin l) (MarginInfo. false true))))
180 | (let [l (vertical-layout {:margin [:vertical :top]})]
181 | (is (= (.getMargin l) (MarginInfo. true false))))
182 | (let [l (vertical-layout {:margin [:vertical :left]})]
183 | (is (= (.getMargin l) (MarginInfo. true false true true))))
184 | (let [l (vertical-layout {:margin [:horizontal :left]})]
185 | (is (= (.getMargin l) (MarginInfo. false true))))
186 | (let [l (vertical-layout {:margin [:top :left]})]
187 | (is (= (.getMargin l) (MarginInfo. true false false true))))
188 | )
189 |
190 | (testing "Computed children"
191 | (let [l (apply vertical-layout (map #(label (str "Label " %1)) (range 0 10)))]
192 | (is (= (.getComponentCount l) 10))
193 | (is (every? #(instance? Label %1) (map #(.getComponent l %1) (range (.getComponentCount l)))))
194 | (is (every? true? (map #(= (.getValue (.getComponent l %1)) (str "Label " %1 )) (range (.getComponentCount l)))))
195 |
196 | )
197 | (let [l (apply vertical-layout {:margin true :spacing true} (map #(label (str "Label " %1)) (range 0 10)))]
198 | (is (.getMargin l))
199 | (is (.isSpacing l))
200 | (is (= (.getComponentCount l) 10))
201 | (is (every? #(instance? Label %1) (map #(.getComponent l %1) (range (.getComponentCount l)))))
202 | (is (every? true? (map #(= (.getValue (.getComponent l %1)) (str "Label " %1 )) (range (.getComponentCount l)))))
203 |
204 | )
205 | )
206 |
207 | (testing "Error handling"
208 | (is (thrown-with-msg?
209 | IllegalArgumentException #"Configuration options must be a Map"
210 | (configure (Button.) :keyword)))
211 | (is (thrown-with-msg?
212 | UnsupportedOperationException #"No such option for class com.vaadin.ui.Button: :wozza"
213 | (configure (Button.) {:wozza "wizzbang"}))))
214 |
215 |
216 |
217 | )
218 |
219 | (deftest login-form-ui
220 | (testing "building"
221 | (let [c (login-form identity)]
222 | (is (instance? LoginForm c)))
223 | (let [c (login-form {:usernameCaption "Enter Username"} identity)]
224 | (is (instance? LoginForm c)))
225 | (is (thrown-with-msg?
226 | IllegalArgumentException #"No arguments supplied to login-form"
227 | (login-form)))))
228 |
--------------------------------------------------------------------------------
/test/functional_vaadin/data_binding_test.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.data-binding-test
9 | (:use [clojure.test]
10 | [functional-vaadin.core]
11 | [functional-vaadin.data-binding])
12 | (:import (com.vaadin.data.util HierarchicalContainer)
13 | (com.vaadin.ui TreeTable)
14 | (com.vaadin.data Container$Hierarchical)))
15 |
16 | (deftest hierarchical
17 | (testing "Adding - select list"
18 | (let [container (add-hierarchy (HierarchicalContainer.)
19 | [{"Parent1"
20 | ["Leaf11" {"Parent21"
21 | ["Leaf12" "Leaf22"]}]}
22 | {"Parent2"
23 | []}
24 | {"Parent3"
25 | ["Leaf13" "Leaf23" "Leaf33"]}])]
26 | (is (instance? HierarchicalContainer container))
27 | (is (= (set (.rootItemIds container)) #{"Parent1" "Parent2" "Parent3"}))
28 | (is (every? (fn [[c p]] (= (.getParent container c) p))
29 | [["Parent1" nil] ["Parent2" nil] ["Parent2" nil]
30 | ["Leaf11" "Parent1"] ["Parent21" "Parent1"]
31 | ["Leaf12" "Parent21"] ["Leaf22" "Parent21"]
32 | ["Leaf13" "Parent3"] ["Leaf23" "Parent3"] ["Leaf33" "Parent3"]
33 | ]))
34 | ))
35 | (testing "Adding - table row"
36 | (doseq [c [
37 | (TreeTable.)
38 | (HierarchicalContainer.)
39 | ]]
40 | (let [container (add-hierarchy
41 | (doto c
42 | (.addContainerProperty "Col1" String nil)
43 | (.addContainerProperty "Col2" String nil)
44 | (.addContainerProperty "Col3" String nil)
45 | )
46 | [{["Row11"]
47 | [["Row21" "Row22" "Row23"]
48 | ["Row31" "Row32" "Row33"]]}
49 | {["Row41"]
50 | [["Row51" "Row52" "Row53"]
51 | {["Row61"]
52 | [["Row71" "Row72" "Row73"]
53 | ["Row81" "Row82" "Row83"]]}]}
54 | ])]
55 | (is (instance? Container$Hierarchical container))
56 | (is (= (set (.rootItemIds container)) #{0 3}))
57 | (is (every? (fn [[c p]] (= (.getParent container c) p))
58 | [[0 nil] [3 nil]
59 | [1 0] [2 0]
60 | [4 3] [5 3]
61 | [6 5] [7 5]
62 | ]))
63 | (is (every? (fn [[id row]]
64 | (= (map #(.getValue (.getContainerProperty container id %1)) (.getContainerPropertyIds container))
65 | row))
66 | (map-indexed #(vector %1 %2)
67 | [["Row11" nil nil]
68 | ["Row21" "Row22" "Row23"]
69 | ["Row31" "Row32" "Row33"]
70 | ["Row41" nil nil]
71 | ["Row51" "Row52" "Row53"]
72 | ["Row61" nil nil]
73 | ["Row71" "Row72" "Row73"]
74 | ["Row81" "Row82" "Row83"]
75 | ])))
76 | )))
77 | (testing "Creating"
78 | (let [container (->Hierarchical
79 | [{"Parent1"
80 | ["Leaf11" {"Parent21"
81 | ["Leaf12" "Leaf22"]}]}
82 | {"Parent2"
83 | []}
84 | {"Parent3"
85 | ["Leaf13" "Leaf23" "Leaf33"]}])]
86 | (is (instance? HierarchicalContainer container))
87 | (is (= (set (.rootItemIds container)) #{"Parent1" "Parent2" "Parent3"}))
88 | (is (every? (fn [[c p]] (= (.getParent container c) p))
89 | [["Parent1" nil] ["Parent2" nil] ["Parent2" nil]
90 | ["Leaf11" "Parent1"] ["Parent21" "Parent1"]
91 | ["Leaf12" "Parent21"] ["Leaf22" "Parent21"]
92 | ["Leaf13" "Parent3"] ["Leaf23" "Parent3"] ["Leaf33" "Parent3"]
93 | ]))
94 | ))
95 | )
96 |
--------------------------------------------------------------------------------
/test/functional_vaadin/event_handling_test.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.event-handling-test
9 | (:use [clojure.test]
10 | [functional-vaadin.core]
11 | [functional-vaadin.event-handling]
12 | [functional-vaadin.utils :refer :all])
13 | (:import (com.vaadin.ui Button Panel Image Embedded FormLayout TextField Field$ValueChangeEvent AbstractComponent)
14 | (com.vaadin.event MouseEvents$ClickEvent)
15 | (com.vaadin.data Property Property$ValueChangeEvent)
16 | (com.vaadin.data.util ObjectProperty)))
17 |
18 | (defn do-mouse-click [component]
19 | (.click
20 | (first (.getListeners component MouseEvents$ClickEvent))
21 | (MouseEvents$ClickEvent. component nil)))
22 |
23 | (deftest button-events
24 | (testing "Firing"
25 | (let [clicked (atom false)
26 | button (onClick
27 | (button)
28 | (fn [src evt fg] (swap! clicked #(vector (not %1) fg src))))]
29 | (.click button)
30 | (is (first @clicked))
31 | (is (nil? (second @clicked)))
32 | (.click button)
33 | (is (not (first @clicked))))
34 | (let [clicked (atom false)
35 | ^FormLayout form (form
36 | (button))
37 | ^Button button (onClick
38 | (.getComponent form 0)
39 | (fn [src evt fg] (swap! clicked #(vector (not %1) fg src))))
40 | field-group (get-field-group form)]
41 | (.click button)
42 | (is (first @clicked))
43 | (is (identical? field-group (second @clicked)))
44 | (is (identical? button (nth @clicked 2)))
45 | (.click button)
46 | (is (not (first @clicked)))
47 | (is (identical? field-group (second @clicked)))
48 | (is (identical? button (nth @clicked 2)))
49 | )))
50 |
51 | (deftest mouse-events
52 | (testing "Panel"
53 | (let [clicked (atom false)
54 | panel (onClick (panel) (fn [comp evt] (swap! clicked #(not %1))))]
55 | (do-mouse-click panel)
56 | (is @clicked)
57 | (do-mouse-click panel)
58 | (is (not @clicked))))
59 | (testing "Image"
60 | (let [clicked (atom false)
61 | image (onClick (image) (fn [comp evt] (swap! clicked #(not %1))))]
62 | (do-mouse-click image)
63 | (is @clicked)
64 | (do-mouse-click image)
65 | (is (not @clicked))))
66 | (testing "Embedded"
67 | (let [clicked (atom false)
68 | embedded (onClick (embedded) (fn [comp evt] (swap! clicked #(not %1))))]
69 | (do-mouse-click embedded)
70 | (is @clicked)
71 | (do-mouse-click embedded)
72 | (is (not @clicked))))
73 | )
74 |
75 | (deftest value-change-events
76 | (testing "Fields"
77 | (let [changed (atom nil)
78 | ^TextField field (onValueChange (text-field)
79 | (fn [comp evt fg]
80 | (swap! changed (fn [_] (vector (.getValue comp) evt fg)))
81 | ))]
82 | (.setValue field "Text1")
83 | (is (vector? @changed))
84 | (is (= (first @changed) "Text1"))
85 | (is (instance? Field$ValueChangeEvent (second @changed)))
86 | (is (nil? (nth @changed 2)))
87 | ))
88 | (testing "Properties"
89 | (let [changed (atom nil)
90 | ^Property prop (onValueChange
91 | (ObjectProperty. "")
92 | (fn [comp evt]
93 | (swap! changed (fn [_] (vector (.getValue comp) evt)))
94 | ))]
95 | (.setValue prop "Text1")
96 | (is (vector? @changed))
97 | (is (= (first @changed) "Text1"))
98 | (is (instance? Property$ValueChangeEvent (second @changed)))
99 | )))
100 |
--------------------------------------------------------------------------------
/test/functional_vaadin/rx/observers_test.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.rx.observers-test
9 | (:require [clojure.test :refer :all]
10 | [rx.lang.clojure.core :as rx]
11 | [functional-vaadin.core :refer :all]
12 | [functional-vaadin.rx.observers :refer :all]
13 | [functional-vaadin.utils :refer :all])
14 | (:import (java.util Map)
15 | (com.vaadin.ui Button Button$ClickEvent FormLayout TextField Label$ValueChangeEvent Field$ValueChangeEvent)))
16 |
17 | (deftest rx-button
18 | (testing "Creation/subscribe"
19 | (let [^Button b (button)
20 | fired (atom nil)]
21 | (-> (button-clicks b)
22 | (rx/subscribe (fn [v] (swap! fired (fn [_] v)))))
23 | (.click b)
24 | (is (instance? Map @fired))
25 | (is (identical? (:source @fired) b))
26 | (is (instance? Button$ClickEvent (:event @fired)))
27 | (is (nil? (:field-group @fired)))
28 | )
29 | (let [^FormLayout form (form (button))
30 | ^Button b (.getComponent form 0)
31 | fired (atom nil)]
32 | (-> (button-clicks b)
33 | (rx/subscribe (fn [v] (swap! fired (fn [_] v)))))
34 | (.click b)
35 | (is (instance? Map @fired))
36 | (is (identical? (:source @fired) b))
37 | (is (instance? Button$ClickEvent (:event @fired)))
38 | (is (identical? (get-field-group form) (:field-group @fired)))
39 | )
40 | ))
41 |
42 | (deftest rx-value-change
43 | (testing "Creation/subscribe"
44 | (let [^TextField field (text-field)
45 | fired (atom nil)]
46 | (-> (value-changes field)
47 | (rx/subscribe (fn [v] (swap! fired (fn [_] v)))))
48 | (.setValue field "New Text")
49 | (is (instance? Map @fired))
50 | (is (identical? (:source @fired) field))
51 | (is (instance? Field$ValueChangeEvent (:event @fired)))
52 | (is (nil? (:field-group @fired)))
53 | )
54 | (let [form (form (text-field "prop"))
55 | ^TextField field (.getComponent form 0)
56 | fired (atom nil)]
57 | (-> (value-changes field)
58 | (rx/subscribe (fn [v] (swap! fired (fn [_] v)))))
59 | (.setValue field "New Text")
60 | (is (instance? Map @fired))
61 | (is (identical? (:source @fired) field))
62 | (is (instance? Field$ValueChangeEvent (:event @fired)))
63 | (is (identical? (get-field-group form) (:field-group @fired)))
64 | )
65 | ))
66 |
67 | (deftest rx-events-in
68 | (let [result (atom [])
69 | o (events-in
70 | (fn [s end]
71 | (loop [i 0]
72 | (when (< i end)
73 | (rx/on-next s i)
74 | (Thread/sleep 100)
75 | (recur (inc i))))) 10)
76 | sub (rx/subscribe o (fn [v] (swap! result #(conj %1 v))))]
77 | (loop [unsub (rx/unsubscribed? sub)]
78 | (Thread/sleep 50)
79 | (if (not unsub)
80 | (recur (rx/unsubscribed? sub))))
81 | (is (= @result (vec (range 0 10))))))
82 |
--------------------------------------------------------------------------------
/test/functional_vaadin/rx/operators_test.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.rx.operators-test
9 | (:require [clojure.test :refer :all]
10 | [rx.lang.clojure.core :as rx]
11 | [functional-vaadin.core :refer :all]
12 | [functional-vaadin.rx.observers :refer :all]
13 | [functional-vaadin.rx.operators :refer :all]
14 | [functional-vaadin.utils :refer :all]
15 | )
16 | (:import (com.vaadin.ui Button$ClickEvent UI)
17 | (java.util Map)
18 | (rx Observable)))
19 |
20 | (deftest rx-operators
21 | (testing "Commit"
22 | (let [form (form (button))
23 | b (.getComponent form 0)
24 | fired (atom nil)]
25 | (rx/subscribe
26 | (->> (button-clicks b)
27 | (commit))
28 | (fn [v] (swap! fired (fn [_] v))))
29 | (.click b)
30 | (is (instance? Map @fired))
31 | (is (identical? (:source @fired) b))
32 | (is (instance? Button$ClickEvent (:event @fired)))
33 | (is (identical? (get-field-group form) (:field-group @fired)))
34 | (is (identical? (.getItemDataSource (:field-group @fired)) (:item @fired)))
35 | )
36 | )
37 | (testing "Consume-for"
38 | (let [b (button) l (label) fired (atom nil)]
39 | (->> (button-clicks b)
40 | (consume-for l (fn [l v] (swap! fired (fn [_] {:component l :value v})))))
41 | ;(fn [v] (swap! fired (fn [_] v)))
42 | (.click b)
43 | (is (identical? (:component @fired) l))
44 | (is (= (keys (:value @fired)) [:source :event :field-group]))
45 | (is (identical? b (get-in @fired [:value :source])))
46 | (is (nil? (get-in @fired [:value :field-group])))
47 | )
48 | )
49 | (testing "with-ui-access"
50 | (let [result (atom nil)
51 | error (atom nil)
52 | ui (proxy [UI] []
53 | (access [rbl] (.run rbl))
54 | (init [rqst] rqst))]
55 | (UI/setCurrent ui)
56 | (rx/subscribe (->>
57 | (Observable/just "It!")
58 | (with-ui-access))
59 | (fn [v] (swap! result (fn [_] v)))
60 | (fn [e] (swap! error (fn [_] e))))
61 | (is (= @result "It!"))
62 | (is (nil? @error))
63 | )
64 | (let [result (atom nil)
65 | error (atom nil)
66 | ui (proxy [UI] []
67 | (access [rbl] (.run rbl))
68 | (init [rqst] rqst))]
69 | (UI/setCurrent ui)
70 | (rx/subscribe (->>
71 | (Observable/error (NullPointerException. "Test"))
72 | (with-ui-access))
73 | (fn [v] (swap! result (fn [_] v)))
74 | (fn [e] (swap! error (fn [_] e))))
75 | (is (nil? @result))
76 | (is (instance? NullPointerException @error))
77 | (is (= (.getMessage @error) "Test"))
78 | )
79 | )
80 | )
81 |
--------------------------------------------------------------------------------
/test/functional_vaadin/ui/TestUI.clj:
--------------------------------------------------------------------------------
1 | (ns functional-vaadin.ui.TestUI
2 | (:require [functional-vaadin.ui.test-ui-def :as u])
3 | (:gen-class :name ^{com.vaadin.annotations.Theme "valo"} functional_vaadin.ui.TestUI
4 | :extends com.vaadin.ui.UI
5 | :main false))
6 |
7 | (defn -init
8 | [main-ui request]
9 | (u/define-test-ui main-ui)
10 | )
11 |
12 |
--------------------------------------------------------------------------------
/test/functional_vaadin/ui/test_ui_def.clj:
--------------------------------------------------------------------------------
1 | (ns functional-vaadin.ui.test-ui-def
2 | (:use functional-vaadin.core
3 | functional-vaadin.rx.operators
4 | functional-vaadin.rx.observers
5 | functional-vaadin.utils)
6 | (:require [rx.lang.clojure.core :as rx])
7 | (:import (com.vaadin.data.util ObjectProperty PropertysetItem)
8 | (com.vaadin.ui VerticalLayout Button$ClickEvent Button Table UI)
9 | (com.vaadin.data.fieldgroup FieldGroup)
10 | (rx Observable)
11 | (java.util.concurrent TimeUnit)))
12 |
13 |
14 | (defn define-test-ui [^UI main-ui]
15 | (defui main-ui
16 | (panel "Main Panel" (tab-sheet)
17 | (horizontal-layout {:sizeFull [] :caption "Form and Table"}
18 | (form {:content (vertical-layout) :id :form :margin true :sizeFull []}
19 | (form-layout
20 | (text-field {:bindTo ["first-name" String] :nullRepresentation ""})
21 | (text-field {:bindTo ["last-name" String] :nullRepresentation ""}))
22 | (horizontal-layout
23 | (button {:caption "Save" :id :save-button}))
24 | )
25 | (vertical-layout {:margin true :sizeFull []}
26 | (table {:caption "People" :sizeFull [] :id :table}
27 | (table-column "first-name" {:header "First Name" :width 200})
28 | (table-column "last-name" {:header "Last Name"})
29 | )
30 | )
31 | )
32 | (vertical-layout {:caption "Background Task"}
33 | (horizontal-layout {:margin true :spacing true}
34 | (button {:caption "Start" :id :start-button})
35 | (button {:caption "Stop" :id :stop-button :enabled false})
36 | (progress-bar {:id :progress :value (float 0.0) :width "300px"}))
37 |
38 | )
39 | )
40 | )
41 | (->> (button-clicks (componentNamed :save-button main-ui)) ; Observe Save button clicks
42 | (commit) ; Commit the form of which it is a part
43 | (consume-for (componentNamed :table main-ui) ; Consume the form data (in :item) and set into the table
44 | (fn [table data]
45 | (let [{:keys [item]} data
46 | row (object-array (map #(.getValue (.getItemProperty item %1)) ["first-name" "last-name"]))]
47 | (.addItem table row nil))
48 | )))
49 | ;
50 | ; Simulate a background job for the progress indicator by using a timer to send events (increasing integers)
51 | ; at 1 second intervals. We update the progress by subscribing to these events.
52 | ;
53 | (let [subscription (atom nil) ; Indicate we are running by saving the timer subsciption
54 | timer (Observable/interval 1 TimeUnit/SECONDS) ; The timer that sends events
55 | progress (componentNamed :progress main-ui ) ; The progress bar component
56 | start-button (componentNamed :start-button main-ui) ; Start and stop button components
57 | stop-button (componentNamed :stop-button main-ui)
58 | stop-fn (fn [clickInfo] ; A function that stops the 'background' job
59 | (when @subscription ; When it's subscribed, timer is running, so unsubscribe and remove the subscription
60 | (swap! subscription (fn [s] (rx/unsubscribe s) nil))
61 | (.setValue progress (float 0.0)) ; Reset the progress bar, and flip button state
62 | (.setEnabled start-button true)
63 | (.setEnabled stop-button false)
64 | ))]
65 | (-> ; Set up the Start button to subscribe to the timer
66 | (button-clicks start-button)
67 | (rx/subscribe (fn [clickInfo]
68 | (when-not @subscription ; When it's not subscribed, subscribe and save the subscription
69 | (swap! subscription ; Also indicate when we are done by using stop-fn
70 | (fn [_]
71 | (rx/subscribe timer
72 | (fn [t]
73 | (.setValue progress (float (/ (inc t) 10)))
74 | (if (> t 9) (stop-fn {}))) ;Stop when we're done
75 | )
76 | ))
77 | (.setEnabled start-button false) ; Flip button state so Start is disabled and Stop enabled
78 | (.setEnabled stop-button true)
79 | ))))
80 | (-> ; Set up the Stop button to stop the action
81 | (button-clicks stop-button)
82 | (rx/subscribe stop-fn))) (.setPollInterval main-ui 500) ; Make the ProgressBar work - we could also use PUSH mode
83 |
84 | )
85 |
--------------------------------------------------------------------------------
/test/functional_vaadin/utils_test.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Copyright 2016 Prajna Inc. All Rights Reserved.
3 | ;;
4 | ;; This work is licensed under the Eclipse Public License v1.0 - https://www.eclipse.org/legal/epl-v10.html
5 | ;; Distrubition and use must be done under the terms of this license
6 | ;;
7 |
8 | (ns functional-vaadin.utils-test
9 | (:use [clojure.test]
10 | [functional-vaadin.utils])
11 | (:import (java.util Map)
12 | (com.vaadin.ui Button)
13 | (functional_vaadin.ui TestUI)))
14 |
15 |
16 | (deftest string-helpers
17 | (testing "Capitalization"
18 | (is (= (capitalize "capCamel") "CapCamel"))
19 | (is (= (capitalize "CapCamel") "CapCamel"))
20 | (is (= (uncapitalize "capCamel") "capCamel"))
21 | (is (= (uncapitalize "CapCamel") "capCamel"))
22 | )
23 | (testing "Capitalization - empty string and nil"
24 | (is (= (capitalize "") ""))
25 | (is (= (capitalize nil) nil))
26 | (is (= (uncapitalize "") ""))
27 | (is (= (uncapitalize nil) nil))
28 | ))
29 |
30 | (deftest component-data
31 | (testing "attach and get"
32 | (let [c (Button.)]
33 | (attach-data c :test-key {:a 1 :b 2})
34 | (is (= (get-data c :test-key) {:a 1 :b 2}))
35 | (is (= (get-data c :test-key) {:a 1 :b 2})) ; Duplicate get to test it does not disapear
36 | ))
37 | (testing "attach and detach"
38 | (let [c (Button.)]
39 | (attach-data c :test-key {:a 1 :b 2})
40 | (is (= (detach-data c :test-key) {:a 1 :b 2}))
41 | (is (nil? (get-data c :test-key)))
42 | ))
43 | (testing "attach and get - mutiple/vector keys"
44 | (let [c (Button.)]
45 | (attach-data c [:test-key] {:a 1 :b 2})
46 | (is (= (get-data c [:test-key]) {:a 1 :b 2}))
47 | (is (= (get-data c [:test-key]) {:a 1 :b 2}))
48 | (is (= (get-data c [:test-key :a]) 1))
49 | (is (= (get-data c [:test-key :b]) 2))
50 | )
51 | (let [c (Button.)]
52 | (attach-data c [:test-key :a] 1)
53 | (attach-data c [:test-key :b] 2)
54 | (is (= (get-data c [:test-key]) {:a 1 :b 2}))
55 | (is (= (get-data c [:test-key]) {:a 1 :b 2}))
56 | (is (= (get-data c [:test-key :a]) 1))
57 | (is (= (get-data c [:test-key :b]) 2))
58 | ))
59 | (testing "attach and detach - multiple/vector keys"
60 | (let [c (Button.)]
61 | (attach-data c :test-key {:a 1 :b 2})
62 | (is (= (detach-data c [:test-key]) {:a 1 :b 2}))
63 | (is (nil? (get-data c [:test-key])))
64 |
65 | (attach-data c :test-key {:a 1 :b 2})
66 | (is (= (detach-data c [:test-key :a]) 1))
67 | (is (= (get-data c [:test-key :b]) 2))
68 | (is (nil? (get-data c [:test-key :a])))
69 | (is (= (detach-data c [:test-key :b]) 2))
70 | (is (nil? (get-data c [:test-key :b])))
71 | (is (nil? (get-data c [:test-key :a])))
72 | (is (= (get-data c [:test-key]) {}))
73 | (is (= (detach-data c :test-key) {}))
74 | (is (nil? (detach-data c :test-key)))
75 | ))
76 | (testing "attach and detach - dot keyword keys"
77 | (let [c (Button.)]
78 | (attach-data c :test-key {:a 1 :b 2})
79 | (is (= (detach-data c :test-key.a) 1))
80 | (is (= (get-data c :test-key.b) 2))
81 | (is (nil? (get-data c :test-key.a)))
82 | (is (= (detach-data c :test-key.b) 2))
83 | (is (nil? (get-data c :test-key.b)))
84 | (is (nil? (get-data c :test-key.a)))
85 | (is (= (detach-data c :test-key) {}))
86 | (is (nil? (detach-data c :test-key)))
87 | ))
88 | (testing "attach and detach - dot String keys"
89 | (let [c (Button.)]
90 | (attach-data c "test-key" {:a 1 :b 2})
91 | (is (= (detach-data c "test-key.a") 1))
92 | (is (= (get-data c "test-key.b") 2))
93 | (is (nil? (get-data c "test-key.a")))
94 | (is (= (detach-data c "test-key.b") 2))
95 | (is (nil? (get-data c "test-key.b")))
96 | (is (nil? (get-data c "test-key.a")))
97 | (is (= (detach-data c "test-key") {}))
98 | (is (nil? (detach-data c "test-key")))
99 | ))
100 | (testing "Key equivalence"
101 | (let [c (Button.)]
102 | (attach-data c "test-key" {:a 1 :b 2})
103 | (is (= (get-data c "test-key.a") 1))
104 | (is (= (get-data c "test-key.b") 2))
105 | (is (= (get-data c :test-key.a) 1))
106 | (is (= (get-data c :test-key.b) 2))
107 | (is (= (get-data c ["test-key" "a"]) 1))
108 | (is (= (get-data c ["test-key" "b"]) 2))
109 | (is (= (get-data c [:test-key :a]) 1))
110 | (is (= (get-data c [:test-key :b]) 2))
111 | ))
112 |
113 | )
114 | (deftest ui-data
115 | (testing "attach/get - components"
116 | (let [ui (TestUI.)
117 | c (Button.)]
118 | (attach-data ui (component-key :button) c)
119 | (is (identical? c (get-data ui (component-key :button))))
120 | (is (identical? c (get-data ui (component-key :button))))
121 | ))
122 | (testing "attach/detach - components"
123 | (let [ui (TestUI.)
124 | c (Button.)]
125 | (attach-data ui (component-key :button) c)
126 | (is (identical? c (get-data ui (component-key :button))))
127 | (is (identical? c (detach-data ui (component-key :button))))
128 | (is (nil? (get-data ui (component-key :button))))
129 | )
130 | )
131 | (testing "attach/get - bindings"
132 | (let [ui (TestUI.)
133 | c {:structure :Map
134 | :bind-type :Item}]
135 | (attach-data ui (binding-key :some.data) c)
136 | (is (identical? c (get-data ui (binding-key :some.data))))
137 | (is (identical? c (get-data ui (binding-key :some.data))))
138 | ))
139 | (testing "attach/detach - bindings"
140 | (let [ui (TestUI.)
141 | c {:structure :Map
142 | :bind-type :Item}]
143 | (attach-data ui (binding-key :some.data) c)
144 | (is (identical? c (get-data ui (binding-key :some.data))))
145 | (is (identical? c (detach-data ui (binding-key :some.data))))
146 | (is (nil? (get-data ui (binding-key :some.data))))
147 | )
148 | )
149 | )
--------------------------------------------------------------------------------