├── .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 | 19 | -------------------------------------------------------------------------------- /.idea/compiler.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 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 | 9 | -------------------------------------------------------------------------------- /.idea/inspectionProfiles/profiles_settings.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 7 | -------------------------------------------------------------------------------- /.idea/leiningen.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 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 | 32 | 33 | 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 | 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 | ![](https://clojars.org/com.prajnainc/functional-vaadin/latest-version.svg) 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 | ) --------------------------------------------------------------------------------