Repository: arthuredelstein/clooj Branch: master Commit: 56d29c807cf6 Files: 24 Total size: 151.3 KB Directory structure: gitextract_trp2l31e/ ├── .clj-kondo/ │ └── config.edn ├── .github/ │ └── CODEOWNERS ├── .gitignore ├── LICENSE.txt ├── README.md ├── project.clj └── src/ └── clooj/ ├── brackets.clj ├── cemerick/ │ └── pomegranate.clj ├── collaj.clj ├── core.clj ├── help.clj ├── highlighting.clj ├── indent.clj ├── navigate.clj ├── project.clj ├── protocols.clj ├── repl/ │ ├── external.clj │ ├── lein.clj │ ├── main.clj │ ├── output.clj │ └── remote.clj ├── search.clj ├── settings.clj └── utils.clj ================================================ FILE CONTENTS ================================================ ================================================ FILE: .clj-kondo/config.edn ================================================ {:linters {:unused-binding {:level :off} :unused-import {:level :off} :unused-namespace {:level :off}} :lint-as {clooj.utils/when-lets clojure.core/let} :output {:linter-name true}} ================================================ FILE: .github/CODEOWNERS ================================================ * @NoahTheDuke @eerohele ================================================ FILE: .gitignore ================================================ .lein-deps-sum classes/ lib/ target/ .lein-repl-history .nrepl-port ================================================ FILE: LICENSE.txt ================================================ Source code distributed under the Eclipse Public License - v 1.0: THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 1. DEFINITIONS "Contribution" means: a) in the case of the initial Contributor, the initial code and documentation distributed under this Agreement, and b) in the case of each subsequent Contributor: i) changes to the Program, and ii) additions to the Program; where such changes and/or additions to the Program originate from and are distributed by that particular Contributor. A Contribution 'originates' from a Contributor if it was added to the Program by such Contributor itself or anyone acting on such Contributor's behalf. Contributions do not include additions to the Program which: (i) are separate modules of software distributed in conjunction with the Program under their own license agreement, and (ii) are not derivative works of the Program. "Contributor" means any person or entity that distributes the Program. "Licensed Patents" mean patent claims licensable by a Contributor which are necessarily infringed by the use or sale of its Contribution alone or when combined with the Program. "Program" means the Contributions distributed in accordance with this Agreement. "Recipient" means anyone who receives the Program under this Agreement, including all Contributors. 2. GRANT OF RIGHTS a) Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free copyright license to reproduce, prepare derivative works of, publicly display, publicly perform, distribute and sublicense the Contribution of such Contributor, if any, and such derivative works, in source code and object code form. b) Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free patent license under Licensed Patents to make, use, sell, offer to sell, import and otherwise transfer the Contribution of such Contributor, if any, in source code and object code form. This patent license shall apply to the combination of the Contribution and the Program if, at the time the Contribution is added by the Contributor, such addition of the Contribution causes such combination to be covered by the Licensed Patents. The patent license shall not apply to any other combinations which include the Contribution. No hardware per se is licensed hereunder. c) Recipient understands that although each Contributor grants the licenses to its Contributions set forth herein, no assurances are provided by any Contributor that the Program does not infringe the patent or other intellectual property rights of any other entity. Each Contributor disclaims any liability to Recipient for claims brought by any other entity based on infringement of intellectual property rights or otherwise. As a condition to exercising the rights and licenses granted hereunder, each Recipient hereby assumes sole responsibility to secure any other intellectual property rights needed, if any. For example, if a third party patent license is required to allow Recipient to distribute the Program, it is Recipient's responsibility to acquire that license before distributing the Program. d) Each Contributor represents that to its knowledge it has sufficient copyright rights in its Contribution, if any, to grant the copyright license set forth in this Agreement. 3. REQUIREMENTS A Contributor may choose to distribute the Program in object code form under its own license agreement, provided that: a) it complies with the terms and conditions of this Agreement; and b) its license agreement: i) effectively disclaims on behalf of all Contributors all warranties and conditions, express and implied, including warranties or conditions of title and non-infringement, and implied warranties or conditions of merchantability and fitness for a particular purpose; ii) effectively excludes on behalf of all Contributors all liability for damages, including direct, indirect, special, incidental and consequential damages, such as lost profits; iii) states that any provisions which differ from this Agreement are offered by that Contributor alone and not by any other party; and iv) states that source code for the Program is available from such Contributor, and informs licensees how to obtain it in a reasonable manner on or through a medium customarily used for software exchange. When the Program is made available in source code form: a) it must be made available under this Agreement; and b) a copy of this Agreement must be included with each copy of the Program. Contributors may not remove or alter any copyright notices contained within the Program. Each Contributor must identify itself as the originator of its Contribution, if any, in a manner that reasonably allows subsequent Recipients to identify the originator of the Contribution. 4. COMMERCIAL DISTRIBUTION Commercial distributors of software may accept certain responsibilities with respect to end users, business partners and the like. While this license is intended to facilitate the commercial use of the Program, the Contributor who includes the Program in a commercial product offering should do so in a manner which does not create potential liability for other Contributors. Therefore, if a Contributor includes the Program in a commercial product offering, such Contributor ("Commercial Contributor") hereby agrees to defend and indemnify every other Contributor ("Indemnified Contributor") against any losses, damages and costs (collectively "Losses") arising from claims, lawsuits and other legal actions brought by a third party against the Indemnified Contributor to the extent caused by the acts or omissions of such Commercial Contributor in connection with its distribution of the Program in a commercial product offering. The obligations in this section do not apply to any claims or Losses relating to any actual or alleged intellectual property infringement. In order to qualify, an Indemnified Contributor must: a) promptly notify the Commercial Contributor in writing of such claim, and b) allow the Commercial Contributor tocontrol, and cooperate with the Commercial Contributor in, the defense and any related settlement negotiations. The Indemnified Contributor may participate in any such claim at its own expense. For example, a Contributor might include the Program in a commercial product offering, Product X. That Contributor is then a Commercial Contributor. If that Commercial Contributor then makes performance claims, or offers warranties related to Product X, those performance claims and warranties are such Commercial Contributor's responsibility alone. Under this section, the Commercial Contributor would have to defend claims against the other Contributors related to those performance claims and warranties, and if a court requires any other Contributor to pay any damages as a result, the Commercial Contributor must pay those damages. 5. NO WARRANTY EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the appropriateness of using and distributing the Program and assumes all risks associated with its exercise of rights under this Agreement , including but not limited to the risks and costs of program errors, compliance with applicable laws, damage to or loss of data, programs or equipment, and unavailability or interruption of operations. 6. DISCLAIMER OF LIABILITY EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 7. GENERAL If any provision of this Agreement is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this Agreement, and without further action by the parties hereto, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable. If Recipient institutes patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Program itself (excluding combinations of the Program with other software or hardware) infringes such Recipient's patent(s), then such Recipient's rights granted under Section 2(b) shall terminate as of the date such litigation is filed. All Recipient's rights under this Agreement shall terminate if it fails to comply with any of the material terms or conditions of this Agreement and does not cure such failure in a reasonable period of time after becoming aware of such noncompliance. If all Recipient's rights under this Agreement terminate, Recipient agrees to cease use and distribution of the Program as soon as reasonably practicable. However, Recipient's obligations under this Agreement and any licenses granted by Recipient relating to the Program shall continue and survive. Everyone is permitted to copy and distribute copies of this Agreement, but in order to avoid inconsistency the Agreement is copyrighted and may only be modified in the following manner. The Agreement Steward reserves the right to publish new versions (including revisions) of this Agreement from time to time. No one other than the Agreement Steward has the right to modify this Agreement. The Eclipse Foundation is the initial Agreement Steward. The Eclipse Foundation may assign the responsibility to serve as the Agreement Steward to a suitable separate entity. Each new version of the Agreement will be given a distinguishing version number. The Program (including Contributions) may always be distributed subject to the version of the Agreement under which it was received. In addition, after a new version of the Agreement is published, Contributor may elect to distribute the Program (including its Contributions) under the new version. Except as expressly stated in Sections 2(a) and 2(b) above, Recipient receives no rights or licenses to the intellectual property of any Contributor under this Agreement, whether expressly, by implication, estoppel or otherwise. All rights in the Program not expressly granted under this Agreement are reserved. This Agreement is governed by the laws of the State of Washington and the intellectual property laws of the United States of America. No party to this Agreement will bring a legal action under this Agreement more than one year after the cause of action arose. Each party waives its rights to a jury trial in any resulting litigation. Images distributed under the Creative Commons Attribution + ShareAlike License version 3.0: THE WORK (AS DEFINED BELOW) IS PROVIDED UNDER THE TERMS OF THIS CREATIVE COMMONS PUBLIC LICENSE ("CCPL" OR "LICENSE"). THE WORK IS PROTECTED BY COPYRIGHT AND/OR OTHER APPLICABLE LAW. ANY USE OF THE WORK OTHER THAN AS AUTHORIZED UNDER THIS LICENSE OR COPYRIGHT LAW IS PROHIBITED. BY EXERCISING ANY RIGHTS TO THE WORK PROVIDED HERE, YOU ACCEPT AND AGREE TO BE BOUND BY THE TERMS OF THIS LICENSE. TO THE EXTENT THIS LICENSE MAY BE CONSIDERED TO BE A CONTRACT, THE LICENSOR GRANTS YOU THE RIGHTS CONTAINED HERE IN CONSIDERATION OF YOUR ACCEPTANCE OF SUCH TERMS AND CONDITIONS. 1. Definitions "Adaptation" means a work based upon the Work, or upon the Work and other pre-existing works, such as a translation, adaptation, derivative work, arrangement of music or other alterations of a literary or artistic work, or phonogram or performance and includes cinematographic adaptations or any other form in which the Work may be recast, transformed, or adapted including in any form recognizably derived from the original, except that a work that constitutes a Collection will not be considered an Adaptation for the purpose of this License. For the avoidance of doubt, where the Work is a musical work, performance or phonogram, the synchronization of the Work in timed-relation with a moving image ("synching") will be considered an Adaptation for the purpose of this License. "Collection" means a collection of literary or artistic works, such as encyclopedias and anthologies, or performances, phonograms or broadcasts, or other works or subject matter other than works listed in Section 1(f) below, which, by reason of the selection and arrangement of their contents, constitute intellectual creations, in which the Work is included in its entirety in unmodified form along with one or more other contributions, each constituting separate and independent works in themselves, which together are assembled into a collective whole. A work that constitutes a Collection will not be considered an Adaptation (as defined below) for the purposes of this License. "Creative Commons Compatible License" means a license that is listed at http://creativecommons.org/compatiblelicenses that has been approved by Creative Commons as being essentially equivalent to this License, including, at a minimum, because that license: (i) contains terms that have the same purpose, meaning and effect as the License Elements of this License; and, (ii) explicitly permits the relicensing of adaptations of works made available under that license under this License or a Creative Commons jurisdiction license with the same License Elements as this License. "Distribute" means to make available to the public the original and copies of the Work or Adaptation, as appropriate, through sale or other transfer of ownership. "License Elements" means the following high-level license attributes as selected by Licensor and indicated in the title of this License: Attribution, ShareAlike. "Licensor" means the individual, individuals, entity or entities that offer(s) the Work under the terms of this License. "Original Author" means, in the case of a literary or artistic work, the individual, individuals, entity or entities who created the Work or if no individual or entity can be identified, the publisher; and in addition (i) in the case of a performance the actors, singers, musicians, dancers, and other persons who act, sing, deliver, declaim, play in, interpret or otherwise perform literary or artistic works or expressions of folklore; (ii) in the case of a phonogram the producer being the person or legal entity who first fixes the sounds of a performance or other sounds; and, (iii) in the case of broadcasts, the organization that transmits the broadcast. "Work" means the literary and/or artistic work offered under the terms of this License including without limitation any production in the literary, scientific and artistic domain, whatever may be the mode or form of its expression including digital form, such as a book, pamphlet and other writing; a lecture, address, sermon or other work of the same nature; a dramatic or dramatico-musical work; a choreographic work or entertainment in dumb show; a musical composition with or without words; a cinematographic work to which are assimilated works expressed by a process analogous to cinematography; a work of drawing, painting, architecture, sculpture, engraving or lithography; a photographic work to which are assimilated works expressed by a process analogous to photography; a work of applied art; an illustration, map, plan, sketch or three-dimensional work relative to geography, topography, architecture or science; a performance; a broadcast; a phonogram; a compilation of data to the extent it is protected as a copyrightable work; or a work performed by a variety or circus performer to the extent it is not otherwise considered a literary or artistic work. "You" means an individual or entity exercising rights under this License who has not previously violated the terms of this License with respect to the Work, or who has received express permission from the Licensor to exercise rights under this License despite a previous violation. "Publicly Perform" means to perform public recitations of the Work and to communicate to the public those public recitations, by any means or process, including by wire or wireless means or public digital performances; to make available to the public Works in such a way that members of the public may access these Works from a place and at a place individually chosen by them; to perform the Work to the public by any means or process and the communication to the public of the performances of the Work, including by public digital performance; to broadcast and rebroadcast the Work by any means including signs, sounds or images. "Reproduce" means to make copies of the Work by any means including without limitation by sound or visual recordings and the right of fixation and reproducing fixations of the Work, including storage of a protected performance or phonogram in digital form or other electronic medium. 2. Fair Dealing Rights. Nothing in this License is intended to reduce, limit, or restrict any uses free from copyright or rights arising from limitations or exceptions that are provided for in connection with the copyright protection under copyright law or other applicable laws. 3. License Grant. Subject to the terms and conditions of this License, Licensor hereby grants You a worldwide, royalty-free, non-exclusive, perpetual (for the duration of the applicable copyright) license to exercise the rights in the Work as stated below: to Reproduce the Work, to incorporate the Work into one or more Collections, and to Reproduce the Work as incorporated in the Collections; to create and Reproduce Adaptations provided that any such Adaptation, including any translation in any medium, takes reasonable steps to clearly label, demarcate or otherwise identify that changes were made to the original Work. For example, a translation could be marked "The original work was translated from English to Spanish," or a modification could indicate "The original work has been modified."; to Distribute and Publicly Perform the Work including as incorporated in Collections; and, to Distribute and Publicly Perform Adaptations. For the avoidance of doubt: Non-waivable Compulsory License Schemes. In those jurisdictions in which the right to collect royalties through any statutory or compulsory licensing scheme cannot be waived, the Licensor reserves the exclusive right to collect such royalties for any exercise by You of the rights granted under this License; Waivable Compulsory License Schemes. In those jurisdictions in which the right to collect royalties through any statutory or compulsory licensing scheme can be waived, the Licensor waives the exclusive right to collect such royalties for any exercise by You of the rights granted under this License; and, Voluntary License Schemes. The Licensor waives the right to collect royalties, whether individually or, in the event that the Licensor is a member of a collecting society that administers voluntary licensing schemes, via that society, from any exercise by You of the rights granted under this License. The above rights may be exercised in all media and formats whether now known or hereafter devised. The above rights include the right to make such modifications as are technically necessary to exercise the rights in other media and formats. Subject to Section 8(f), all rights not expressly granted by Licensor are hereby reserved. 4. Restrictions. The license granted in Section 3 above is expressly made subject to and limited by the following restrictions: You may Distribute or Publicly Perform the Work only under the terms of this License. You must include a copy of, or the Uniform Resource Identifier (URI) for, this License with every copy of the Work You Distribute or Publicly Perform. You may not offer or impose any terms on the Work that restrict the terms of this License or the ability of the recipient of the Work to exercise the rights granted to that recipient under the terms of the License. You may not sublicense the Work. You must keep intact all notices that refer to this License and to the disclaimer of warranties with every copy of the Work You Distribute or Publicly Perform. When You Distribute or Publicly Perform the Work, You may not impose any effective technological measures on the Work that restrict the ability of a recipient of the Work from You to exercise the rights granted to that recipient under the terms of the License. This Section 4(a) applies to the Work as incorporated in a Collection, but this does not require the Collection apart from the Work itself to be made subject to the terms of this License. If You create a Collection, upon notice from any Licensor You must, to the extent practicable, remove from the Collection any credit as required by Section 4(c), as requested. If You create an Adaptation, upon notice from any Licensor You must, to the extent practicable, remove from the Adaptation any credit as required by Section 4(c), as requested. You may Distribute or Publicly Perform an Adaptation only under the terms of: (i) this License; (ii) a later version of this License with the same License Elements as this License; (iii) a Creative Commons jurisdiction license (either this or a later license version) that contains the same License Elements as this License (e.g., Attribution-ShareAlike 3.0 US)); (iv) a Creative Commons Compatible License. If you license the Adaptation under one of the licenses mentioned in (iv), you must comply with the terms of that license. If you license the Adaptation under the terms of any of the licenses mentioned in (i), (ii) or (iii) (the "Applicable License"), you must comply with the terms of the Applicable License generally and the following provisions: (I) You must include a copy of, or the URI for, the Applicable License with every copy of each Adaptation You Distribute or Publicly Perform; (II) You may not offer or impose any terms on the Adaptation that restrict the terms of the Applicable License or the ability of the recipient of the Adaptation to exercise the rights granted to that recipient under the terms of the Applicable License; (III) You must keep intact all notices that refer to the Applicable License and to the disclaimer of warranties with every copy of the Work as included in the Adaptation You Distribute or Publicly Perform; (IV) when You Distribute or Publicly Perform the Adaptation, You may not impose any effective technological measures on the Adaptation that restrict the ability of a recipient of the Adaptation from You to exercise the rights granted to that recipient under the terms of the Applicable License. This Section 4(b) applies to the Adaptation as incorporated in a Collection, but this does not require the Collection apart from the Adaptation itself to be made subject to the terms of the Applicable License. If You Distribute, or Publicly Perform the Work or any Adaptations or Collections, You must, unless a request has been made pursuant to Section 4(a), keep intact all copyright notices for the Work and provide, reasonable to the medium or means You are utilizing: (i) the name of the Original Author (or pseudonym, if applicable) if supplied, and/or if the Original Author and/or Licensor designate another party or parties (e.g., a sponsor institute, publishing entity, journal) for attribution ("Attribution Parties") in Licensor's copyright notice, terms of service or by other reasonable means, the name of such party or parties; (ii) the title of the Work if supplied; (iii) to the extent reasonably practicable, the URI, if any, that Licensor specifies to be associated with the Work, unless such URI does not refer to the copyright notice or licensing information for the Work; and (iv) , consistent with Ssection 3(b), in the case of an Adaptation, a credit identifying the use of the Work in the Adaptation (e.g., "French translation of the Work by Original Author," or "Screenplay based on original Work by Original Author"). The credit required by this Section 4(c) may be implemented in any reasonable manner; provided, however, that in the case of a Adaptation or Collection, at a minimum such credit will appear, if a credit for all contributing authors of the Adaptation or Collection appears, then as part of these credits and in a manner at least as prominent as the credits for the other contributing authors. For the avoidance of doubt, You may only use the credit required by this Section for the purpose of attribution in the manner set out above and, by exercising Your rights under this License, You may not implicitly or explicitly assert or imply any connection with, sponsorship or endorsement by the Original Author, Licensor and/or Attribution Parties, as appropriate, of You or Your use of the Work, without the separate, express prior written permission of the Original Author, Licensor and/or Attribution Parties. Except as otherwise agreed in writing by the Licensor or as may be otherwise permitted by applicable law, if You Reproduce, Distribute or Publicly Perform the Work either by itself or as part of any Adaptations or Collections, You must not distort, mutilate, modify or take other derogatory action in relation to the Work which would be prejudicial to the Original Author's honor or reputation. Licensor agrees that in those jurisdictions (e.g. Japan), in which any exercise of the right granted in Section 3(b) of this License (the right to make Adaptations) would be deemed to be a distortion, mutilation, modification or other derogatory action prejudicial to the Original Author's honor and reputation, the Licensor will waive or not assert, as appropriate, this Section, to the fullest extent permitted by the applicable national law, to enable You to reasonably exercise Your right under Section 3(b) of this License (right to make Adaptations) but not otherwise. 5. Representations, Warranties and Disclaimer UNLESS OTHERWISE MUTUALLY AGREED TO BY THE PARTIES IN WRITING, LICENSOR OFFERS THE WORK AS-IS AND MAKES NO REPRESENTATIONS OR WARRANTIES OF ANY KIND CONCERNING THE WORK, EXPRESS, IMPLIED, STATUTORY OR OTHERWISE, INCLUDING, WITHOUT LIMITATION, WARRANTIES OF TITLE, MERCHANTIBILITY, FITNESS FOR A PARTICULAR PURPOSE, NONINFRINGEMENT, OR THE ABSENCE OF LATENT OR OTHER DEFECTS, ACCURACY, OR THE PRESENCE OF ABSENCE OF ERRORS, WHETHER OR NOT DISCOVERABLE. SOME JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF IMPLIED WARRANTIES, SO SUCH EXCLUSION MAY NOT APPLY TO YOU. 6. Limitation on Liability. EXCEPT TO THE EXTENT REQUIRED BY APPLICABLE LAW, IN NO EVENT WILL LICENSOR BE LIABLE TO YOU ON ANY LEGAL THEORY FOR ANY SPECIAL, INCIDENTAL, CONSEQUENTIAL, PUNITIVE OR EXEMPLARY DAMAGES ARISING OUT OF THIS LICENSE OR THE USE OF THE WORK, EVEN IF LICENSOR HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 7. Termination This License and the rights granted hereunder will terminate automatically upon any breach by You of the terms of this License. Individuals or entities who have received Adaptations or Collections from You under this License, however, will not have their licenses terminated provided such individuals or entities remain in full compliance with those licenses. Sections 1, 2, 5, 6, 7, and 8 will survive any termination of this License. Subject to the above terms and conditions, the license granted here is perpetual (for the duration of the applicable copyright in the Work). Notwithstanding the above, Licensor reserves the right to release the Work under different license terms or to stop distributing the Work at any time; provided, however that any such election will not serve to withdraw this License (or any other license that has been, or is required to be, granted under the terms of this License), and this License will continue in full force and effect unless terminated as stated above. 8. Miscellaneous Each time You Distribute or Publicly Perform the Work or a Collection, the Licensor offers to the recipient a license to the Work on the same terms and conditions as the license granted to You under this License. Each time You Distribute or Publicly Perform an Adaptation, Licensor offers to the recipient a license to the original Work on the same terms and conditions as the license granted to You under this License. If any provision of this License is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this License, and without further action by the parties to this agreement, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable. No term or provision of this License shall be deemed waived and no breach consented to unless such waiver or consent shall be in writing and signed by the party to be charged with such waiver or consent. This License constitutes the entire agreement between the parties with respect to the Work licensed here. There are no understandings, agreements or representations with respect to the Work not specified here. Licensor shall not be bound by any additional provisions that may appear in any communication from You. This License may not be modified without the mutual written agreement of the Licensor and You. The rights granted under, and the subject matter referenced, in this License were drafted utilizing the terminology of the Berne Convention for the Protection of Literary and Artistic Works (as amended on September 28, 1979), the Rome Convention of 1961, the WIPO Copyright Treaty of 1996, the WIPO Performances and Phonograms Treaty of 1996 and the Universal Copyright Convention (as revised on July 24, 1971). These rights and subject matter take effect in the relevant jurisdiction in which the License terms are sought to be enforced according to the corresponding provisions of the implementation of those treaty provisions in the applicable national law. If the standard suite of rights granted under applicable copyright law includes additional rights not granted under this License, such additional rights are deemed to be included in the License; this License is not intended to restrict the license of any rights under applicable law. ================================================ FILE: README.md ================================================ --- clooj, a lightweight IDE for clojure --- ### the application clooj is a small, simple IDE (integrated development environment) for the [clojure](http://clojure.org) programming language, [available for free download](http://www.mediafire.com/?kxa2an0k0ings). clooj is written entirely in clojure and uses a swing-based GUI. It is cross-platform (assuming Java 1.6 or 1.7 has been installed on your operating system), and runs as a standalone application. The application is a single jar file that can be launched by double-clicking its file icon or by running java -jar clooj-XXX-STANDALONE.jar from the command line. ### the layout The clooj window contains three columns. The left-most column is a tree showing clojure projects and the source files they contain. The middle column is the source file editor. The right column displays inputs and outputs of clojure REPLs (read-evaluate-print loops). ### the source editor The source code editor offers a few simple things to make writing clojure code easier: * A non-traditional bracket-matching feature highlights in gray those brackets that contain the innermost form you are currently editing, and the argument list for the function or macro at the head of the form is displayed. * Mismatched or unmatched brackets are highlighted in pink. * cmd+[ indents, and cmd+] unindents. * cmd+\ cleans up indentation. * Automatically comment-out (and un-comment-out) multiple lines. * When newlines are entered, the next line is automatically indented. * Press ctrl-ENTER to send either the nearest root form or the selected text to the REPL. * Double-clicking a paren causes its form to be selected. * Source files are continuously saved in the background to prevent accidental loss of your work in the event of a crash. * Syntax highlighting (using the [RSyntaxTextArea](http://fifesoft.com/rsyntaxtextarea/) library). ### clojure projects Each clojure project corresponds to a project directory somewhere in the file system, containing a src directory. Inside the src directory is the source code hierarchy, composed of directories and .clj files. Note this directory structure is completely compatible with the [lein build tool](http://leiningen.org/) for clojure. We recommend the use of lein in alongside the clooj editor. Clicking different source files in the projects tree will automatically change the source file currently being edited, as well as switch the REPL to the appropriate namespace. ### read-evaluate-print loop The upper part of clooj's REPL display column shows the REPL history (inputs and outputs) and the lower part is a text area for inputting forms into REPL. clooj runs a single REPL at a time. By choosing "Restart REPL" you cause the current REPL's process to be shut down and a new REPL to be launched. The new REPL's working directory will be located in the main directory of the currently selected project. If lein is installed, the new REPL's classpath will automatically include the full lein classpath. ### name search, documentation and auto-completion clooj can help you search for functions and other names, provide documentation for these names, and auto-complete your code. (This feature is in the early stages of development.) When help is activated, a list of available names similar to the local text is shown at left. At right, documentation and source code is shown for the selected name. Press TAB or shift+TAB to browse through the list, then press ENTER to replace what you have typed with the name you have selected. Press ESC to get out of help mode. ### more work needed clooj is a work in progress. Please post any suggestions or criticisms to the [clooj Google group](http://groups.google.com/group/clooj) or to the [github issues list](https://github.com/arthuredelstein/clooj/issues). All feedback is much appreciated. Code contributions in the form of github pull requests are also very welcome! If you want to start building and working on clooj, then please read the [building clooj from source wiki page](https://github.com/arthuredelstein/clooj/wiki/Building-clooj). -- Arthur Edelstein ================================================ FILE: project.clj ================================================ (defproject clooj "0.5" :description "clooj, a small IDE for clojure" :url "https://github.com/clj-commons/clooj" :license {:name "Eclipse Public License" :url "http://www.eclipse.org/legal/epl-v10.html"} :main clooj.core :jvm-opts ["--add-exports" "java.desktop/com.apple.eawt=ALL-UNNAMED"] :dependencies [[org.clojure/clojure "1.11.1"] [clj-inspector "0.0.16"] [slamhound "1.5.5"] [com.cemerick/pomegranate "1.1.0"] [com.fifesoft/rsyntaxtextarea "3.4.0"] [nrepl/nrepl "1.1.1"]]) ================================================ FILE: src/clooj/brackets.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.brackets (:import (javax.swing.text JTextComponent)) (:require [clojure.string :as string] [clooj.utils :as utils])) (defn mismatched-brackets [a b] (and (or (nil? a) (some #{a} [\( \[ \{])) (some #{b} [\) \] \}]) (not (some #{[a b]} [[\( \)] [\[ \]] [\{ \}]])))) (defn process-bracket-stack "Receiving a bracket stack s, deal with the next character c and datum dat." [s c dat] (let [l (ffirst s) ;last char p (next s) ;pop stack j (conj s [c dat])] ;conj [char dat] to stack (condp = l \\ p \" (condp = c, \" p, \\ j, s) \; (if (= c \newline) p s) (condp = c \" j \\ j \; j ;" \( j \[ j \{ j \) p \] p \} p s)))) (defn find-enclosing-brackets [text pos] (let [process #(process-bracket-stack %1 %2 nil) reckon-dist (fn [stacks] (let [scores (map count stacks)] (utils/count-while #(<= (first scores) %) scores))) before (.substring text 0 (Math/min (.length text) pos)) stacks-before (reverse (reductions process nil before)) left (- pos (reckon-dist stacks-before)) after (.substring text (Math/min (.length text) pos)) stacks-after (reductions process (first stacks-before) after) right (+ -1 pos (reckon-dist stacks-after))] [left right])) (defn find-bad-brackets [text] (loop [t text pos 0 stack nil errs nil] (let [c (first t) ;this char new-stack (process-bracket-stack stack c pos) e (when (mismatched-brackets (ffirst stack) c) (list (first stack) [c pos])) new-errs (if e (concat errs e) errs)] (if (next t) (recur (next t) (inc pos) new-stack new-errs) (filter identity (map second (concat new-stack errs))))))) (defn blank-line-matcher [s] (re-matcher #"[\n\r]\s*?[\n\r]" s)) (defn find-left-gap [text pos] (let [p (min (.length text) (inc pos)) before-reverse (string/reverse (.substring text 0 p)) matcher (blank-line-matcher before-reverse)] (if (.find matcher) (- p (.start matcher)) 0))) (defn find-right-gap [text pos] (let [p (max 0 (dec pos)) after (.substring text p) matcher (blank-line-matcher after) ] (if (.find matcher) (+ p (.start matcher)) (.length text)))) (defn find-line-group [text-comp] (let [text (utils/get-text-str text-comp) pos (.getCaretPosition text-comp)] [(find-left-gap text pos) (find-right-gap text pos)])) ================================================ FILE: src/clooj/cemerick/pomegranate.clj ================================================ (ns clooj.cemerick.pomegranate ;; borrowed from pomegranate library (:import (clojure.lang DynamicClassLoader) (java.net URL URLClassLoader)) (:require [clojure.java.io :as io]) (:refer-clojure :exclude (add-classpath))) ;; call-method pulled from clojure.contrib.reflect, (c) 2010 Stuart Halloway & Contributors (defn- call-method "Calls a private or protected method. params is a vector of classes which correspond to the arguments to the method e obj is nil for static methods, the instance object otherwise. The method-name is given a symbol or a keyword (something Named)." [klass method-name params obj & args] (-> klass (.getDeclaredMethod (name method-name) (into-array Class params)) (doto (.setAccessible true)) (.invoke obj (into-array Object args)))) (defprotocol URLClasspath "Ability to dynamically add urls to classloaders. This protocol is an implementation detail. Use `modifiable-classloader?` and `add-classpath` or `add-dependencies` unless you are extending a type to this protocol." (^{:private true} can-modify? [this] "Returns true if the given classloader can be modified.") (^{:private true} add-url [this url] "add the url to the classpath")) (extend-type DynamicClassLoader URLClasspath (can-modify? [this] true) (add-url [this url] (.addURL this url))) (def ^:private url-classloader-base {:can-modify? (constantly true) :add-url (fn [this url] (call-method URLClassLoader 'addURL [URL] this url))}) (extend URLClassLoader URLClasspath url-classloader-base) (defmacro when-resolves [sym & body] (when (resolve sym) `(do ~@body))) (when-resolves sun.misc.Launcher (extend sun.misc.Launcher$ExtClassLoader URLClasspath (assoc url-classloader-base :can-modify? (constantly false)))) (defn classloader-hierarchy "Returns a seq of classloaders, with the tip of the hierarchy first. Uses (clojure.lang.RT/baseLoader) -- which by default will be the current thread context ClassLoader -- as the tip ClassLoader if one is not provided." ([] (classloader-hierarchy (clojure.lang.RT/baseLoader))) ([tip] (->> tip (iterate #(.getParent %)) (take-while boolean)))) (defn modifiable-classloader? "Returns true iff the given ClassLoader is of a type that satisfies the URLClasspath protocol, and it can be modified." [cl] (and (satisfies? URLClasspath cl) (can-modify? cl))) (defn add-classpath "A corollary to the (deprecated) `add-classpath` in clojure.core. This implementation requires a java.io.File or String path to a jar file or directory, and will attempt to add that path to the right classloader (with the search rooted at the current thread's context classloader)." ([jar-or-dir classloader] (add-url classloader (.toURL (io/file jar-or-dir)))) ([jar-or-dir] (let [classloaders (classloader-hierarchy)] (if-let [cl (last (filter modifiable-classloader? classloaders))] (add-classpath jar-or-dir cl) (throw (IllegalStateException. "Could not find a suitable classloader to modify from " classloaders)))))) ;; removed add-dependencies so that we don't need to load aether stuff -- @arthuredelstein (defn get-classpath "Returns the effective classpath (i.e. _not_ the value of (System/getProperty \"java.class.path\") as a seq of URL strings. Produces the classpath from all classloaders by default, or from a collection of classloaders if provided. This allows you to easily look at subsets of the current classloader hierarchy, e.g.: (get-classpath (drop 2 (classloader-hierarchy)))" ([classloaders] [] (->> (reverse classloaders) (mapcat #(when (instance? URLClassLoader %) (.getURLs %))) (map str))) ([] (get-classpath (classloader-hierarchy)))) ================================================ FILE: src/clooj/collaj.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.collaj (:require [clojure.edn :as edn]) (:import (java.net URLEncoder))) (defn url-encode "URL-encode a string." [s] (URLEncoder/encode s "UTF-8")) (defn raw-data "Get a clojure data collection of raw search results from collaj.net" [terms] (edn/read-string (slurp (str "http://collaj.net/?format=raw&q=" (url-encode terms))))) ================================================ FILE: src/clooj/core.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.core (:import (javax.swing AbstractListModel BorderFactory JDialog JFrame JLabel JList JMenuBar JOptionPane JPanel JScrollPane JSplitPane JTextArea JTextField JTree KeyStroke SpringLayout JTextPane JCheckBox JButton ListSelectionModel UIManager) (javax.swing.event TreeSelectionListener TreeExpansionListener) (javax.swing.tree DefaultMutableTreeNode DefaultTreeModel TreePath TreeSelectionModel) (java.awt Insets Rectangle Window) (java.awt.event AWTEventListener FocusAdapter MouseAdapter WindowAdapter ActionListener KeyAdapter) (java.awt AWTEvent Color Font GridLayout Toolkit) (java.net URL) (java.util.concurrent LinkedBlockingQueue) (java.util Map) (java.io File FileReader StringReader BufferedWriter OutputStreamWriter FileOutputStream) (org.fife.ui.rsyntaxtextarea RSyntaxTextArea SyntaxConstants TokenMakerFactory) (org.fife.ui.rtextarea RTextScrollPane)) (:require [clojure.set] [clooj.repl.main :as repl] [clooj.repl.output :as repl-output] [clooj.utils :as utils] [clooj.help :as help] [clooj.navigate :as navigate] [clooj.project :as project] [clooj.indent :as indent] [clooj.brackets :as brackets] [clooj.highlighting :as highlighting] [clooj.search :as search] [clooj.settings :as settings]) (:gen-class :methods [^{:static true} [show [] void]])) (def gap 5) (def embedded (atom false)) (def changing-file (atom false)) (defprotocol DynamicWordHighlighter (addWordToHighlight [this word token-type])) (extend-type RSyntaxTextArea DynamicWordHighlighter (addWordToHighlight [word token-type])) (defn make-rsyntax-text-area [] (let [tmf (TokenMakerFactory/getDefaultInstance) token-maker (.getTokenMaker tmf "text/clojure") token-map (.getWordsToHighlight token-maker) rsta (proxy [RSyntaxTextArea] [] (addWordToHighlight [word token-type] (do (.put token-map word token-type) token-type)))] (.. rsta getDocument (setTokenMakerFactory tmf)) rsta)) (defn make-text-area [wrap] (doto (RSyntaxTextArea.) (.setAnimateBracketMatching false) (.setBracketMatchingEnabled false) (.setAutoIndentEnabled false) (.setAntiAliasingEnabled true) (.setLineWrap wrap) )) (def get-clooj-version (memoize (fn [] (try (-> (Thread/currentThread) .getContextClassLoader (.getResource "clooj/core.class") .toString (.replace "clooj/core.class" "project.clj") URL. slurp read-string (nth 2)) (catch Exception _ nil))))) ;; settings (def default-settings (merge (zipmap [:font-name :font-size] (cond (utils/is-mac) ["Monaco" 11] (utils/is-win) ["Courier New" 12] :else ["Monospaced" 12])) {:line-wrap-doc false :line-wrap-repl-out false :line-wrap-repl-in false :show-only-monospaced-fonts true })) (defn load-settings [] (atom (merge default-settings (utils/read-value-from-prefs utils/clooj-prefs "settings")))) (defn save-settings [settings] (utils/write-value-to-prefs utils/clooj-prefs "settings" settings)) (defn apply-settings [app settings] (letfn [(set-line-wrapping [text-area mode] (.setLineWrap text-area mode)) (set-font [app font-name size] (let [f (Font. font-name Font/PLAIN size)] (utils/awt-event (dorun (map #(.setFont (app %) f) [:doc-text-area :repl-in-text-area :repl-out-text-area :arglist-label :search-text-area :help-text-area :completion-list])))))] (set-line-wrapping (:doc-text-area app) (:line-wrap-doc settings)) (set-line-wrapping (:repl-in-text-area app) (:line-wrap-repl-in settings)) (set-line-wrapping (:repl-out-text-area app) (:line-wrap-repl-out settings)) (set-font app (:font-name settings) (:font-size settings))) (reset! (:settings app) settings) (save-settings settings)) ;; font (defn resize-font [app fun] (apply-settings app (update-in @(:settings app) [:font-size] fun))) (defn grow-font [app] (resize-font app inc)) (defn shrink-font [app] (resize-font app dec)) ;; caret finding (def highlight-agent (agent nil)) (def arglist-agent (agent nil)) (def caret-position (atom nil)) (defn save-caret-position [app] (utils/when-lets [text-area (app :doc-text-area) pos (get @caret-position text-area) file @(:file app)] (when-not (.isDirectory file) (let [key-str (str "caret_" (.hashCode (.getAbsolutePath file)))] (utils/write-value-to-prefs utils/clooj-prefs key-str pos))))) (defn load-caret-position [app] (utils/when-lets [text-area (app :doc-text-area) file @(:file app)] (when-not (.isDirectory file) (utils/when-lets [key-str (str "caret_" (.hashCode (.getAbsolutePath file))) pos (utils/read-value-from-prefs utils/clooj-prefs key-str)] (let [length (.. text-area getDocument getLength) pos2 (Math/min pos length)] (.setCaretPosition text-area pos2) (utils/scroll-to-caret text-area)))))) (defn update-caret-position [text-comp] (swap! caret-position assoc text-comp (.getCaretPosition text-comp))) (defn display-caret-position [doc-text-area app] (let [{:keys [row col]} (utils/get-caret-coords doc-text-area)] (.setText (:pos-label app) (str " " (inc row) "|" (inc col))))) (defn handle-caret-move [app text-comp ns] (update-caret-position text-comp) (help/help-handle-caret-move app text-comp) (let [text (utils/get-text-str text-comp)] (send-off highlight-agent (fn [old-pos] (try (let [pos (@caret-position text-comp)] (when-not (= pos old-pos) (let [enclosing-brackets (brackets/find-enclosing-brackets text pos) bad-brackets (brackets/find-bad-brackets text) good-enclosures (clojure.set/difference (set enclosing-brackets) (set bad-brackets))] (utils/awt-event (highlighting/highlight-brackets text-comp good-enclosures bad-brackets))))) (catch Throwable t (utils/awt-event (.printStackTrace t)))))) (when ns (send-off arglist-agent (fn [old-pos] (try (let [pos (@caret-position text-comp)] (when-not (= pos old-pos) (let [arglist-text (help/arglist-from-caret-pos app ns text pos)] (utils/awt-event (.setText (:arglist-label app) arglist-text))))) (catch Throwable t (utils/awt-event (.printStackTrace t))))))))) ;; highlighting (defn activate-caret-highlighter [app] (when-let [text-comp (app :doc-text-area)] (let [f #(handle-caret-move app % (repl/get-file-ns app))] (utils/add-caret-listener text-comp f) (utils/add-text-change-listener text-comp f))) (when-let [text-comp (app :repl-in-text-area)] (let [f #(handle-caret-move app % (repl/get-file-ns app))] (utils/add-caret-listener text-comp f) (utils/add-text-change-listener text-comp f)))) ;; double-click paren to select form (defn double-click-selector [text-comp] (.addMouseListener text-comp (proxy [MouseAdapter] [] (mouseClicked [e] (when (== 2 (.getClickCount e)) (utils/when-lets [pos (.viewToModel text-comp (.getPoint e)) c (.. text-comp getDocument (getText pos 1) (charAt 0)) pos (cond (#{\( \[ \{ \"} c) (inc pos) (#{\) \] \} \"} c) pos) [a b] (brackets/find-enclosing-brackets (utils/get-text-str text-comp) pos)] (utils/set-selection text-comp a (inc b)))))))) ;; temp files (defn dump-temp-doc [app orig-f txt] (try (when orig-f (let [orig (.getAbsolutePath orig-f) f (.getAbsolutePath (project/get-temp-file orig-f))] (spit f txt) (utils/awt-event (.repaint (app :docs-tree))) )) (catch Exception e nil))) (def temp-file-manager (agent 0)) (defn update-temp [app] (let [text-comp (app :doc-text-area) txt (utils/get-text-str text-comp) f @(app :file)] (send-off temp-file-manager (fn [old-pos] (try (when-let [pos (get @caret-position text-comp)] (when-not (= old-pos pos) (dump-temp-doc app f txt)) pos) (catch Throwable t (utils/awt-event (.printStackTrace t)))))))) (defn setup-temp-writer [app] (let [text-comp (:doc-text-area app)] (utils/add-text-change-listener text-comp #(when-not @changing-file (update-caret-position %) (update-temp app))))) (declare restart-doc) (defn file-suffix [^File f] (utils/when-lets [name (.getName f) last-dot (.lastIndexOf name ".") suffix (.substring name (inc last-dot))] suffix)) (defn text-file? [f] (not (some #{(file-suffix f)} ["jar" "class" "dll" "jpg" "png" "bmp"]))) (defn setup-tree [app] (let [tree (:docs-tree app) save #(project/save-expanded-paths tree)] (doto tree (.setRootVisible false) (.setShowsRootHandles true) (.. getSelectionModel (setSelectionMode TreeSelectionModel/SINGLE_TREE_SELECTION)) (.addTreeExpansionListener (reify TreeExpansionListener (treeCollapsed [this e] (save)) (treeExpanded [this e] (save)))) (.addTreeSelectionListener (reify TreeSelectionListener (valueChanged [this e] (utils/awt-event (project/save-tree-selection tree (.getNewLeadSelectionPath e)) (let [f (.. e getPath getLastPathComponent getUserObject)] (when (and (not= f @(app :file)) (text-file? f)) (restart-doc app f)))))))))) ;; build gui (defn make-scroll-pane [text-area] (RTextScrollPane. text-area)) (defn setup-search-elements [app] (.setVisible (:search-match-case-checkbox app) false) (.setVisible (:search-regex-checkbox app) false) (doto (:search-close-button app) (.setVisible false) (.setBorder nil) (.addActionListener (reify ActionListener (actionPerformed [_ _] (search/stop-find app))))) (let [sta (doto (app :search-text-area) (.setVisible false) (.setBorder (BorderFactory/createLineBorder Color/DARK_GRAY)))] (utils/add-text-change-listener sta #(search/update-find-highlight % app false)) (utils/attach-action-keys sta ["ENTER" #(search/highlight-step app false)] ["shift ENTER" #(search/highlight-step app true)] ["ESCAPE" #(search/escape-find app)]))) (defn create-arglist-label [] (doto (JLabel.) (.setVisible true) )) (defn exit-if-closed [^java.awt.Window f app] (when-not @embedded (.addWindowListener f (proxy [WindowAdapter] [] (windowClosing [_] (save-caret-position app) (System/exit 0)))))) (def no-project-txt "\n Welcome to clooj, a lightweight IDE for clojure\n To start coding, you can either\n a. create a new project (select the Project > New... menu), or b. open an existing project (select the Project > Open... menu)\n and then either\n a. create a new file (select the File > New menu), or b. open an existing file (click on it in the tree at left).") (def no-file-txt "To edit source code you need to either:
 1. create a new file (select menu File > New...)
 2. edit an existing file by selecting one at left.") (defn move-caret-to-line "Move caret to choosen line" [textarea] (let [current-line (fn [] (inc (.getLineOfOffset textarea (.getCaretPosition textarea)))) line-str (utils/ask-value "Line number:" "Go to Line") line-num (Integer. (if (or (nil? line-str) (nil? (re-find #"\d+" line-str))) (current-line) (re-find #"\d+" line-str)))] (utils/scroll-to-line textarea line-num) (.requestFocus textarea))) (defn open-project [app] (when-let [dir (utils/choose-directory (app :f) "Choose a project directory")] (let [project-dir (if (= (.getName dir) "src") (.getParentFile dir) dir)] (utils/write-value-to-prefs utils/clooj-prefs "last-open-dir" (.getAbsolutePath (.getParentFile project-dir))) (project/add-project app (.getAbsolutePath project-dir)) (project/update-project-tree (:docs-tree app)) (when-let [clj-file (or (-> (File. project-dir "src") .getAbsolutePath (project/get-code-files ".clj") first) project-dir)] (utils/awt-event (project/set-tree-selection (app :docs-tree) (.getAbsolutePath clj-file))))))) (defn attach-global-action-keys [comp app] (utils/attach-action-keys comp ["cmd1 EQUALS" #(grow-font app)] ["cmd1 shift EQUALS" #(grow-font app)] ["cmd1 PLUS" #(grow-font app)] ["cmd2 MINUS" #(.toBack (:frame app))] ["cmd2 PLUS" #(.toFront (:frame app))] ["cmd2 EQUALS" #(.toFront (:frame app))] ["cmd1 shift O" #(open-project app)] ["cmd1 K"#(.setText (app :repl-out-text-area) "")])) (defn on-window-activation [win fun] (.addWindowListener win (proxy [WindowAdapter] [] (windowActivated [_] (fun))))) (defn new-doc-text-area [app] (doto (make-text-area false) navigate/attach-navigation-keys double-click-selector (utils/add-caret-listener #(display-caret-position % app)) (help/setup-tab-help app) indent/setup-autoindent )) (defn create-app [] (let [doc-text-panel (JPanel.) doc-label (JLabel. "Source Editor") repl-out-text-area (make-text-area false) repl-out-scroll-pane (repl-output/tailing-scroll-pane repl-out-text-area) repl-out-writer (repl/make-repl-writer repl-out-text-area) repl-in-text-area (make-text-area false) help-text-area (make-text-area true) help-text-scroll-pane (JScrollPane. help-text-area) completion-panel (JPanel.) completion-label (JLabel. "Name search") completion-list (JList.) completion-scroll-pane (JScrollPane. completion-list) search-text-area (JTextField.) search-match-case-checkbox (JCheckBox. "Match case") search-regex-checkbox (JCheckBox. "Regex") search-close-button (JButton. "X") arglist-label (create-arglist-label) pos-label (JLabel.) frame (JFrame.) cp (.getContentPane frame) layout (SpringLayout.) docs-tree (JTree.) docs-tree-scroll-pane (JScrollPane. docs-tree) docs-tree-panel (JPanel.) docs-tree-label (JLabel. "Projects") doc-split-pane (utils/make-split-pane docs-tree-panel doc-text-panel true gap 0.25) repl-split-pane (utils/make-split-pane repl-out-scroll-pane (make-scroll-pane repl-in-text-area) false gap 0.75) repl-panel (JPanel.) repl-label (JLabel. "Clojure REPL output") repl-input-label (JLabel. "Clojure REPL input \u2191") split-pane (utils/make-split-pane doc-split-pane repl-panel true gap 0.5) app (merge {:file (atom nil) :repl (atom nil) :var-maps (atom nil) :classpath-queue (LinkedBlockingQueue.) :changed false} (utils/gen-map doc-label repl-out-text-area repl-in-text-area repl-label frame help-text-area help-text-scroll-pane repl-out-scroll-pane docs-tree docs-tree-scroll-pane docs-tree-panel docs-tree-label search-text-area search-match-case-checkbox search-regex-checkbox search-close-button pos-label repl-out-writer doc-split-pane repl-split-pane split-pane arglist-label completion-list completion-scroll-pane completion-panel )) doc-text-area (new-doc-text-area app) doc-scroll-pane (make-scroll-pane doc-text-area) app (assoc app :doc-text-area doc-text-area) app (assoc app :settings (load-settings))] (doto frame (.setBounds 25 50 950 700) (.setLayout layout) (.add split-pane) (.setTitle (str "clooj " (get-clooj-version)))) (doto doc-text-panel (.setLayout (SpringLayout.)) (.add doc-scroll-pane) (.add doc-label) (.add pos-label) (.add search-text-area) (.add arglist-label) (.add search-match-case-checkbox) (.add search-regex-checkbox) (.add search-close-button)) (doto docs-tree-panel (.setLayout (SpringLayout.)) (.add docs-tree-label) (.add docs-tree-scroll-pane)) (doto repl-panel (.setLayout (SpringLayout.)) (.add repl-label) (.add repl-input-label) (.add repl-split-pane)) (doto completion-panel (.setLayout (SpringLayout.)) (.add completion-label) (.add completion-scroll-pane)) (utils/constrain-to-parent completion-label :n 0 :w 0 :n 15 :e 0) (utils/constrain-to-parent completion-scroll-pane :n 16 :w 0 :s 0 :e 0) (utils/constrain-to-parent repl-label :n 0 :w 0 :n 15 :e 0) (utils/constrain-to-parent repl-input-label :s -15 :w 0 :s 0 :e 0) (utils/constrain-to-parent repl-split-pane :n 16 :w 0 :s -16 :e 0) (utils/constrain-to-parent docs-tree-label :n 0 :w 0 :n 15 :e 0) (utils/constrain-to-parent docs-tree-scroll-pane :n 16 :w 0 :s 0 :e 0) (help/setup-completion-list completion-list app) (doto pos-label (.setFont (Font. "Courier" Font/PLAIN 13))) (doto repl-in-text-area double-click-selector navigate/attach-navigation-keys) (.setSyntaxEditingStyle repl-in-text-area SyntaxConstants/SYNTAX_STYLE_CLOJURE) (.setSyntaxEditingStyle repl-out-text-area SyntaxConstants/SYNTAX_STYLE_CLOJURE) (.setModel docs-tree (DefaultTreeModel. nil)) (utils/constrain-to-parent split-pane :n gap :w gap :s (- gap) :e (- gap)) (utils/constrain-to-parent doc-label :n 0 :w 0 :n 15 :e 0) (utils/constrain-to-parent doc-scroll-pane :n 16 :w 0 :s -16 :e 0) (utils/constrain-to-parent pos-label :s -14 :w 0 :s 0 :w 100) (utils/constrain-to-parent search-text-area :s -15 :w 100 :s 0 :w 350) (utils/constrain-to-parent search-match-case-checkbox :s -15 :w 355 :s 0 :w 470) (utils/constrain-to-parent search-regex-checkbox :s -15 :w 475 :s 0 :w 550) (utils/constrain-to-parent search-close-button :s -15 :w 65 :s 0 :w 95) (utils/constrain-to-parent arglist-label :s -14 :w 80 :s -1 :e -10) (.layoutContainer layout frame) (exit-if-closed frame app) (setup-search-elements app) (activate-caret-highlighter app) (setup-temp-writer app) (utils/attach-action-keys doc-text-area ["cmd1 ENTER" #(repl/send-selected-to-repl app)]) (doto repl-out-text-area (.setEditable false)) (doto help-text-area (.setEditable false) (.setBackground (Color. 0xFF 0xFF 0xE8))) (indent/setup-autoindent repl-in-text-area) (dorun (map #(attach-global-action-keys % app) [docs-tree doc-text-area repl-in-text-area repl-out-text-area (.getContentPane frame)])) app)) ;; clooj docs (defn restart-doc [app ^File file] (let [f @(:file app) txt (utils/get-text-str (:doc-text-area app))] (send-off temp-file-manager (let [temp-file (project/get-temp-file f)] (fn [_] (when (and f temp-file (.exists temp-file)) (dump-temp-doc app f txt)) 0)))) (await temp-file-manager) (let [frame (app :frame) text-area (app :doc-text-area) temp-file (project/get-temp-file file) file-to-open (if (and temp-file (.exists temp-file)) temp-file file) doc-label (app :doc-label)] ;(utils/remove-text-change-listeners text-area) (reset! changing-file true) (save-caret-position app) (.. text-area getHighlighter removeAllHighlights) (if (and file-to-open (.exists file-to-open) (.isFile file-to-open)) (do (let [txt (slurp file-to-open) rdr (StringReader. txt)] (.read text-area rdr nil)) (.discardAllEdits text-area) (.setText doc-label (str "Source Editor \u2014 " (.getPath file))) (.setEditable text-area true) (.setSyntaxEditingStyle text-area (let [file-name (.getName file-to-open)] (if (or (.endsWith file-name ".clj") (.endsWith file-name ".clj~")) SyntaxConstants/SYNTAX_STYLE_CLOJURE SyntaxConstants/SYNTAX_STYLE_NONE)))) (do (.setText text-area no-project-txt) (.setText doc-label (str "Source Editor (No file selected)")) (.setEditable text-area false))) (indent/setup-autoindent text-area) (reset! (app :file) file) (load-caret-position app) (update-caret-position text-area) (repl/apply-namespace-to-repl app) (reset! changing-file false))) (defn save-file [app] (try (let [f @(app :file) ft (File. (str (.getAbsolutePath f) "~"))] (with-open [writer (BufferedWriter. (OutputStreamWriter. (FileOutputStream. f) "UTF-8"))] (.write (app :doc-text-area) writer)) (send-off temp-file-manager (fn [_] 0)) (.delete ft) (.repaint (app :docs-tree)) ) (catch Exception e (JOptionPane/showMessageDialog nil "Unable to save file." "Oops" JOptionPane/ERROR_MESSAGE)))) (def project-clj-text (.trim " (defproject PROJECTNAME \"1.0.0-SNAPSHOT\" :description \"FIXME: write description\" :dependencies [[org.clojure/clojure \"1.5.1\"]]) ")) (defn specify-source [project-dir title default-namespace] (when-let [namespace (JOptionPane/showInputDialog nil "Please enter a fully-qualified namespace" title JOptionPane/QUESTION_MESSAGE nil nil default-namespace)] (let [tokens (map munge (.split namespace "\\.")) dirs (cons "src" (butlast tokens)) dirstring (apply str (interpose File/separator dirs)) name (last tokens) the-dir (File. project-dir dirstring)] (.mkdirs the-dir) [(File. the-dir (str name ".clj")) namespace]))) (defn create-file [app project-dir default-namespace] (when-let [[file namespace] (specify-source project-dir "Create a source file" default-namespace)] (let [tree (:docs-tree app)] (spit file (str "(ns " namespace ")\n")) (project/update-project-tree (:docs-tree app)) (project/set-tree-selection tree (.getAbsolutePath file))))) (defn new-project-clj [app project-dir] (let [project-name (.getName project-dir) file-text (.replace project-clj-text "PROJECTNAME" project-name)] (spit (File. project-dir "project.clj") file-text))) (defn new-project [app] (try (when-let [dir (utils/choose-file (app :frame) "Create a project directory" "" false)] (utils/awt-event (let [path (.getAbsolutePath dir)] (.mkdirs (File. dir "src")) (new-project-clj app dir) (project/add-project app path) (project/update-project-tree (:docs-tree app)) (project/set-tree-selection (app :docs-tree) path) (create-file app dir (str (.getName dir) ".core"))))) (catch Exception e (do (JOptionPane/showMessageDialog nil "Unable to create project." "Oops" JOptionPane/ERROR_MESSAGE) (.printStackTrace e))))) (defn rename-file [app] (when-let [old-file @(app :file)] (let [tree (app :docs-tree) [file namespace] (specify-source (first (project/get-selected-projects app)) "Rename a source file" (repl/get-file-ns app))] (when file (.renameTo @(app :file) file) (project/update-project-tree (:docs-tree app)) (utils/awt-event (project/set-tree-selection tree (.getAbsolutePath file))))))) (defn delete-file [app] (let [path (project/get-selected-file-path app)] (when (utils/confirmed? "Are you sure you want to delete this file?\nDeleting cannot be undone." path) (loop [f (File. path)] (when (and (empty? (.listFiles f)) (let [p (-> f .getParentFile .getAbsolutePath)] (or (.contains p (str File/separator "src" File/separator)) (.endsWith p (str File/separator "src"))))) (.delete f) (recur (.getParentFile f)))) (project/update-project-tree (app :docs-tree))))) (defn remove-project [app] (when (utils/confirmed? "Remove the project from list? (No files will be deleted.)" "Remove project") (project/remove-selected-project app))) (defn revert-file [app] (when-let [f @(:file app)] (let [temp-file (project/get-temp-file f)] (when (.exists temp-file) (let [path (.getAbsolutePath f)] (when (utils/confirmed? "Revert the file? This cannot be undone." path) (.delete temp-file) (project/update-project-tree (:docs-tree app)) (restart-doc app f))))))) (defn- dir-rank [dir] (get {"src" 0 "test" 1 "lib" 2} (.getName dir) 100)) (defn- find-file [project-path relative-file-path] (let [classpath-dirs (sort-by dir-rank < (utils/get-directories (File. project-path))) file-candidates (map #(File. (str (.getAbsolutePath %) File/separatorChar relative-file-path)) classpath-dirs)] (first (filter #(and (.exists %) (.isFile %)) file-candidates)))) (defn goto-definition [ns app] (let [text-comp (:doc-text-area app) pos (.getCaretPosition text-comp) text (.getText text-comp) src-file (:file (meta (do (help/token-from-caret-pos text pos) nil))) line (:line (meta (do (find-ns (symbol ns)) (help/token-from-caret-pos text pos) nil))) project-path (first (project/get-selected-projects app)) file (find-file project-path src-file)] (when (and file line) (when (not= file @(:file app)) (restart-doc app file) (project/set-tree-selection (:docs-tree app) (.getAbsolutePath file))) (utils/scroll-to-line text-comp line)))) (defn make-menus [app] (when (utils/is-mac) (System/setProperty "apple.laf.useScreenMenuBar" "true")) (let [menu-bar (JMenuBar.)] (. (app :frame) setJMenuBar menu-bar) (let [file-menu (utils/add-menu menu-bar "File" "F" ["New" "N" "cmd1 N" #(create-file app (first (project/get-selected-projects app)) "")] ["Save" "S" "cmd1 S" #(save-file app)] ["Move/Rename" "M" nil #(rename-file app)] ["Revert" "R" nil #(revert-file app)] ["Delete" nil nil #(delete-file app)])] (when-not (utils/is-mac) (utils/add-menu-item file-menu "Exit" "X" nil #(System/exit 0)))) (utils/add-menu menu-bar "Project" "P" ["New..." "N" "cmd1 shift N" #(new-project app)] ["Open..." "O" "cmd1 shift O" #(open-project app)] ["Move/Rename" "M" nil #(project/rename-project app)] ["Remove" nil nil #(remove-project app)]) (utils/add-menu menu-bar "Source" "U" ["Comment" "C" "cmd1 SEMICOLON" #(utils/toggle-comment (:doc-text-area app))] ["Fix indentation" "F" "cmd1 BACK_SLASH" #(indent/fix-indent-selected-lines (:doc-text-area app))] ["Indent lines" "I" "cmd1 CLOSE_BRACKET" #(utils/indent (:doc-text-area app))] ["Unindent lines" "D" "cmd1 OPEN_BRACKET" #(utils/unindent (:doc-text-area app))] ["Name search/docs" "S" "TAB" #(help/show-tab-help app (help/find-focused-text-pane app) inc)] ["Go to line..." "G" "cmd1 L" #(move-caret-to-line (:doc-text-area app))] ;["Go to definition" "G" "cmd1 D" #(goto-definition (repl/get-file-ns app) app)] ) (utils/add-menu menu-bar "REPL" "R" ["Evaluate here" "E" "cmd1 ENTER" #(repl/send-selected-to-repl app)] ["Evaluate entire file" "F" "cmd1 E" #(repl/send-doc-to-repl app)] ["Apply file ns" "A" "cmd1 shift A" #(repl/apply-namespace-to-repl app)] ["Clear output" "C" "cmd1 K" #(.setText (app :repl-out-text-area) "")] ["Restart" "R" "cmd1 R" #(repl/restart-repl app (first (project/get-selected-projects app)))] ["Print stack trace for last error" "T" "cmd1 T" #(repl/print-stack-trace app)]) (utils/add-menu menu-bar "Search" "S" ["Find" "F" "cmd1 F" #(search/start-find app)] ["Find next" "N" "cmd1 G" #(search/highlight-step app false)] ["Find prev" "P" "cmd1 shift G" #(search/highlight-step app true)]) (utils/add-menu menu-bar "Window" "W" ["Go to REPL input" "R" "cmd1 3" #(.requestFocusInWindow (:repl-in-text-area app))] ["Go to Editor" "E" "cmd1 2" #(.requestFocusInWindow (:doc-text-area app))] ["Go to Project Tree" "P" "cmd1 1" #(.requestFocusInWindow (:docs-tree app))] ["Increase font size" nil "cmd1 PLUS" #(grow-font app)] ["Decrease font size" nil "cmd1 MINUS" #(shrink-font app)] ["Settings" nil nil #(settings/show-settings-window app apply-settings)]))) (defn add-visibility-shortcut [app] (let [shortcuts [(map utils/get-keystroke ["cmd2 EQUALS" "cmd2 PLUS"])]] (.. Toolkit getDefaultToolkit (addAWTEventListener (proxy [AWTEventListener] [] (eventDispatched [e] (when (some #{(KeyStroke/getKeyStrokeForEvent e)} shortcuts) (.toFront (:frame app))))) AWTEvent/KEY_EVENT_MASK)))) ;; startup (defonce current-app (atom nil)) (defn startup [] (Thread/setDefaultUncaughtExceptionHandler (proxy [Thread$UncaughtExceptionHandler] [] (uncaughtException [thread exception] (println thread) (.printStackTrace exception)))) (UIManager/setLookAndFeel (UIManager/getSystemLookAndFeelClassName)) (let [app (create-app)] (reset! current-app app) (make-menus app) (add-visibility-shortcut app) (repl/add-repl-input-handler app) (help/setup-tab-help (app :repl-in-text-area) app) (doall (map #(project/add-project app %) (project/load-project-set))) (let [frame (app :frame)] (utils/persist-window-shape utils/clooj-prefs "main-window" frame) (.setVisible frame true) (on-window-activation frame #(project/update-project-tree (app :docs-tree)))) (setup-temp-writer app) (setup-tree app) (let [tree (app :docs-tree)] (project/load-expanded-paths tree) (when (false? (project/load-tree-selection tree)) (repl/start-repl app nil))) (apply-settings app @(:settings app)))) (defn -show [] (reset! embedded true) (if (not @current-app) (startup) (.setVisible (:frame @current-app) true))) (defn -main [& args] (reset! embedded false) (startup)) ;; testing (defn get-text [] (utils/get-text-str (@current-app :doc-text-area))) ; not working yet: ;(defn restart ; "Restart the application" ; [] ; (.setVisible (@current-app :frame) false) ; (startup)) ================================================ FILE: src/clooj/help.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.help (:import (java.io LineNumberReader InputStreamReader PushbackReader) (clojure.lang RT Reflector) (java.lang.reflect Modifier) (java.awt Color Point) (java.util Vector) (javax.swing DefaultListCellRenderer ListSelectionModel) (javax.swing.event ListSelectionListener) (java.io File)) (:require [clojure.repl] [clojure.string :as string] [clooj.collaj :as collaj] [clooj.utils :as utils] [clooj.brackets :as brackets] [cemerick.pomegranate.aether :as aether] [clj-inspector.jars :as jars] [clj-inspector.vars :as vars])) (def var-maps-agent (agent nil)) ; from http://clojure.org/special_forms (def special-forms {"def" "(def symbol init?)" "if" "(if test then else?)" "do" "(do exprs*)" "let" "(let [bindings* ] exprs*)" "quote" "(quote form)" "var" "(var symbol)" "fn" "(fn name? [params* ] exprs*)" "loop" "(loop [bindings* ] exprs*)" "recur" "(recur exprs*)" "throw" "(throw expr)" "try" "(try expr* catch-clause* finally-clause?)" "catch" "(catch classname name expr*)" "monitor-enter" "Avoid!" "monitor-exit" "Avoid!"}) (defn present-item [item] (str (:name item) " [" (:ns item) "]")) (defn make-var-super-map [var-maps] (into {} (for [var-map var-maps] [[(:ns var-map) (:name var-map)] var-map]))) (defn classpath-to-jars [project-path classpath] (apply concat (for [item classpath] (cond (.endsWith item "*") (jars/jar-files (apply str (butlast item))) (.endsWith item ".jar") (list (File. item)) :else (jars/jar-files item))))) (defn get-sources-from-jars [project-path classpath] (->> (classpath-to-jars project-path classpath) (mapcat jars/clj-sources-from-jar) merge vals)) (defn get-sources-from-clj-files [classpath] (map slurp (apply concat (for [item classpath] (let [item-file (File. item)] (when (.isDirectory item-file) (filter #(.endsWith (.getName %) ".clj") (file-seq item-file)))))))) (defn get-var-maps [project-path classpath] (make-var-super-map (mapcat #(vars/analyze-clojure-source "clj" %) (concat (get-sources-from-jars project-path classpath) (get-sources-from-clj-files classpath))))) (defn update-var-maps! [project-path classpath] (send-off var-maps-agent #(merge % (get-var-maps project-path classpath)))) (defn find-form-string [text pos] (let [[left right] (brackets/find-enclosing-brackets text pos)] (when (> (.length text) left) (.substring text (inc left))))) (def non-token-chars [\; \~ \@ \( \) \[ \] \{ \} \ \. \newline \/ \" \']) (defn local-token-location [text pos] (let [n (.length text) pos (-> pos (Math/max 0) (Math/min n))] [(loop [p (dec pos)] (if (or (neg? p) (some #{(.charAt text p)} non-token-chars)) (inc p) (recur (dec p)))) (loop [p pos] (if (or (>= p n) (some #{(.charAt text p)} non-token-chars)) p (recur (inc p))))])) (defn head-token [form-string] (when form-string (second (re-find #"(.*?)[\s|\)|$]" (str (.trim form-string) " "))))) (defn current-ns-form [app] (-> app :doc-text-area .getText read-string)) (defn ns-available-names [app] (vars/parse-ns-form (current-ns-form app))) (defn arglist-from-var-map [m] (or (when-let [args (:arglists m)] (str (-> m :ns) "/" (:name m) ": " args)) "")) (defn token-from-caret-pos [text pos] (head-token (find-form-string text pos))) (defn var-from-token [app current-ns token] (when token (if (.contains token "/") (vec (.split token "/")) (or ((ns-available-names app) token) [current-ns token])))) (defn arglist-from-token [app ns token] (or (special-forms token) (when-let [repl (:repl app)] (-> @var-maps-agent (get (var-from-token app ns token)) arglist-from-var-map)))) (defn arglist-from-caret-pos [app ns text pos] (let [token (token-from-caret-pos text pos)] (arglist-from-token app ns token))) ;; tab help (defonce help-state (atom {:visible false :token nil :pos nil})) (defn var-map [v] (when-let [m (meta v)] (let [ns (:ns m)] (-> m (select-keys [:doc :ns :name :arglists]) (assoc :source (binding [*ns* ns] (clojure.repl/source-fn (symbol (str ns "/" name))))))))) (defn var-help [var-map] (let [{:keys [doc ns name arglists source]} var-map] (str name (if ns (str " [" ns "]") "") "\n" arglists "\n\n" (if doc (str "Documentation:\n" doc) "No documentation found.") "\n\n" (if source (str "Source:\n" (if doc (.replace source doc "...docs...") source)) "No source found.")))) (defn create-param-list ([method-or-constructor static] (str " ([" (let [type-names (map #(.getSimpleName %) (.getParameterTypes method-or-constructor)) param-names (if static type-names (cons "this" type-names))] (apply str (interpose " " param-names))) "])")) ([method-or-constructor] (create-param-list method-or-constructor true))) (defn constructor-help [constructor] (str (.. constructor getDeclaringClass getSimpleName) "." (create-param-list constructor))) (defn method-help [method] (let [stat (Modifier/isStatic (.getModifiers method))] (str (if stat (str (.. method getDeclaringClass getSimpleName) "/" (.getName method)) (str "." (.getName method))) (create-param-list method stat) " --> " (.getName (.getReturnType method))))) (defn field-help [field] (let [c (.. field getDeclaringClass getSimpleName)] (str (if (Modifier/isStatic (.getModifiers field)) (str (.. field getDeclaringClass getSimpleName) "/" (.getName field) (when (Modifier/isFinal (.getModifiers field)) (str " --> " (.. field (get nil) toString)))) (str "." (.getName field) " --> " (.getName (.getType field))))))) (defn class-help [c] (apply str (concat [(present-item c) "\n java class"] ["\n\nCONSTRUCTORS\n"] (interpose "\n" (sort (for [constructor (.getConstructors c)] (constructor-help constructor)))) ["\n\nMETHODS\n"] (interpose "\n" (sort (for [method (.getMethods c)] (method-help method)))) ["\n\nFIELDS\n"] (interpose "\n" (sort (for [field (.getFields c)] (field-help field))))))) (defn item-help [item] (cond (map? item) (var-help item) (class? item) (class-help item))) (defn set-first-component [split-pane comp] (let [loc (.getDividerLocation split-pane)] (.setTopComponent split-pane comp) (.setDividerLocation split-pane loc))) (defn clock-num [i n] (if (zero? n) 0 (cond (< i 0) (dec n) (>= i n) 0 :else i))) (defn list-size [list] (-> list .getModel .getSize)) (defn match-items [pattern items] (->> items (filter #(re-find pattern (:name %))) (sort-by #(.toLowerCase (:name %))))) (defn hits [token] (let [token-pat1 (re-pattern (str "(?i)\\A\\Q" token "\\E")) token-pat2 (re-pattern (str "(?i)\\A.\\Q" token "\\E")) items (vals @var-maps-agent) best (match-items token-pat1 items) others (match-items token-pat2 items) ;collaj-items (or (try (collaj/raw-data token) (catch Throwable _))) ] (concat best others #_collaj-items))) (defn show-completion-list [{:keys [completion-list repl-split-pane help-text-scroll-pane doc-split-pane completion-panel repl-label]:as app}] (when (pos? (list-size completion-list)) (set-first-component repl-split-pane help-text-scroll-pane) (set-first-component doc-split-pane completion-panel) (.setText repl-label "Documentation") (.ensureIndexIsVisible completion-list (.getSelectedIndex completion-list)))) (defn advance-help-list [app token index-change-fn] (let [help-list (app :completion-list)] (if (not= token (@help-state :token)) (do (swap! help-state assoc :token token) (.setListData help-list (Vector. (hits token))) (.setSelectedIndex help-list 0)) (let [n (list-size help-list)] (when (pos? n) (.setSelectedIndex help-list (clock-num (index-change-fn (.getSelectedIndex help-list)) n)))))) (show-completion-list app)) (defn get-list-item [app] (-> app :completion-list .getSelectedValue)) (defn get-list-artifact [app] (when-let [artifact (:artifact (get-list-item app))] (binding [*read-eval* false] (read-string artifact)))) (defn get-list-token [app] (let [val (get-list-item app)] (str (:ns val) "/" (:name val)))) (defn show-help-text [app choice] (let [help-text (or (when choice (item-help choice)) "")] (.setText (app :help-text-area) help-text)) (-> app :help-text-scroll-pane .getViewport (.setViewPosition (Point. (int 0) (int 0))))) (defn show-tab-help [app text-comp index-change-fn] (utils/awt-event (let [text (utils/get-text-str text-comp) pos (.getCaretPosition text-comp) [start stop] (local-token-location text pos)] (when-let [token (.substring text start stop)] (swap! help-state assoc :pos start :visible true) (advance-help-list app token index-change-fn))))) (defn hide-tab-help [app] (utils/awt-event (when (@help-state :visible) (set-first-component (app :repl-split-pane) (app :repl-out-scroll-pane)) (set-first-component (app :doc-split-pane) (app :docs-tree-panel)) (.setText (app :repl-label) "Clojure REPL output")) (swap! help-state assoc :visible false :pos nil))) (defn help-handle-caret-move [app text-comp] (utils/awt-event (when (@help-state :visible) (let [[start _] (local-token-location (utils/get-text-str text-comp) (.getCaretPosition text-comp))] (if-not (= start (@help-state :pos)) (hide-tab-help app) (show-tab-help app text-comp identity)))))) (defn update-ns-form [app] (current-ns-form app)) (defn add-classpath-to-repl [app files] (.addAll (app :classpath-queue) files)) (defn load-dependencies [app artifact] (utils/awt-event (utils/append-text (app :repl-out-text-area) (str "\nLoading " artifact " ... "))) (let [deps (cemerick.pomegranate.aether/resolve-dependencies :coordinates [artifact] :repositories (merge aether/maven-central {"clojars" "http://clojars.org/repo"}))] (add-classpath-to-repl app (aether/dependency-files deps))) (utils/append-text (app :repl-out-text-area) (str "done."))) (defn update-token [app text-comp new-token] (utils/awt-event (let [[start stop] (local-token-location (utils/get-text-str text-comp) (.getCaretPosition text-comp)) len (- stop start)] (when (and (seq new-token) (-> app :completion-list .getModel .getSize pos?)) (.. text-comp getDocument (replace start len new-token nil)))))) (defn setup-tab-help [text-comp app] (utils/attach-action-keys text-comp ["TAB" #(show-tab-help app text-comp inc)] ["shift TAB" #(show-tab-help app text-comp dec)] ["ESCAPE" #(hide-tab-help app)]) (utils/attach-child-action-keys text-comp ["ENTER" #(@help-state :visible) #(do (hide-tab-help app) (.start (Thread. (fn [] (load-dependencies app (get-list-artifact app))))) (update-token app text-comp (get-list-token app)))])) (defn find-focused-text-pane [app] (let [t1 (app :doc-text-area) t2 (app :repl-in-text-area)] (cond (.hasFocus t1) t1 (.hasFocus t2) t2))) (defn setup-completion-list [l app] (doto l (.setBackground (Color. 0xFF 0xFF 0xE8)) (.setFocusable false) (.setSelectionMode ListSelectionModel/SINGLE_SELECTION) (.setCellRenderer (proxy [DefaultListCellRenderer] [] (getListCellRendererComponent [list item index isSelected cellHasFocus] (doto (proxy-super getListCellRendererComponent list item index isSelected cellHasFocus) (.setText (present-item item)))))) (.addListSelectionListener (reify ListSelectionListener (valueChanged [_ e] (when-not (.getValueIsAdjusting e) (.ensureIndexIsVisible l (.getSelectedIndex l)) (show-help-text app (.getSelectedValue l)))))) (utils/on-click 2 #(when-let [text-pane (find-focused-text-pane app)] (update-token app text-pane (get-list-token app)))))) ================================================ FILE: src/clooj/highlighting.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.highlighting (:import (javax.swing.text DefaultHighlighter DefaultHighlighter$DefaultHighlightPainter) (java.awt Color) (javax.swing.event CaretListener)) (:require [clooj.utils :as utils])) (defn highlight ([text-comp start stop color] (when (and (<= 0 start) (<= stop (.. text-comp getDocument getLength))) (.. text-comp getHighlighter (addHighlight start stop (DefaultHighlighter$DefaultHighlightPainter. color))))) ([text-comp pos color] (highlight text-comp pos (inc pos) color))) (defn remove-highlight ([text-comp highlight-object] (when highlight-object (.removeHighlight (.getHighlighter text-comp) highlight-object)))) (defn remove-highlights [text-comp highlights] (dorun (map #(remove-highlight text-comp %) highlights))) (def highlights (atom {})) (defn highlight-brackets [text-comp good-enclosures bad-brackets] (utils/awt-event (remove-highlights text-comp (get @highlights text-comp)) (swap! highlights assoc text-comp (doall (concat (map #(highlight text-comp % Color/LIGHT_GRAY) good-enclosures) (map #(highlight text-comp % Color/PINK) bad-brackets)))))) ================================================ FILE: src/clooj/indent.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.indent (:require [clooj.utils :as utils] [clooj.brackets :as brackets] [clojure.string :as string]) (:import (javax.swing.text DocumentFilter))) ;(defn t [] (@clooj.core/current-app :doc-text-area)) (def special-tokens ["def" "defn" "defmacro" "let" "for" "loop" "doseq" "if" "when" "binding" "case" "definline" "defmacro" "condp" "when-let" "if-let" "fn" "proxy" "reify" "when-first" "defmethod" "defmulti" "defn-" "defprotocol" "defrecord" "defstruct" "deftype" "dotimes" "doto" "extend" "extend-protocol" "extend-type" "if-not" "letfn" "ns" "update-proxy" "with-in-str" "with-local-vars" "with-out-str" "when-let" "when-not" "while" "with-bindings" "with-bindings*"]) (defn first-token [txt] (second (re-find #"\((.+?)\s" txt))) (defn second-token-pos [txt] (when-let [x (re-find #".+?\s" (string/trimr (first (.split #"\r?\n" txt))))] (.length x))) (defn left-paren-indent-size [txt] (let [token1 (first-token txt)] (or (when (and token1 (not (or (some #{token1} special-tokens) (.startsWith (string/triml token1) "[")))) (second-token-pos txt)) 2))) (defn compute-indent-size [text-comp offset] (let [bracket-pos (first (brackets/find-enclosing-brackets (utils/get-text-str text-comp) offset))] (when (<= 0 bracket-pos) (let [bracket (.. text-comp getText (charAt bracket-pos)) col (:col (utils/get-coords text-comp bracket-pos))] (if (= bracket \;) (compute-indent-size text-comp bracket-pos) (+ col (condp = bracket \( (left-paren-indent-size (.. text-comp getDocument (getText bracket-pos (- offset bracket-pos)))) \\ 0 \[ 1 \{ 1 \" 1 1))))))) (defn fix-indent [text-comp line] (let [start (.getLineStartOffset text-comp line) end (.getLineEndOffset text-comp line) document (.getDocument text-comp) line-text (.getText document start (- end start)) old-indent-size (count (re-find #"\A\ +" line-text))] (when-let [new-indent-size (compute-indent-size text-comp start)] (let [delta (- new-indent-size old-indent-size)] (if (pos? delta) (.insertString document start (apply str (repeat delta " ")) nil) (.remove document start (- delta))))))) (defn fix-indent-selected-lines [text-comp] (utils/awt-event (dorun (map #(fix-indent text-comp %) (utils/get-selected-lines text-comp))))) (defn auto-indent-str [text-comp offset] (let [indent-size (or (compute-indent-size text-comp offset) 0)] (apply str "\n" (repeat indent-size " ")))) (defn setup-autoindent [text-comp] (utils/attach-action-keys text-comp ["cmd1 BACK_SLASH" #(fix-indent-selected-lines text-comp)] ; "cmd1 \" ["cmd1 CLOSE_BRACKET" #(utils/indent text-comp)] ; "cmd1 ]" ["cmd1 OPEN_BRACKET" #(utils/unindent text-comp)]) ; "cmd1 [" (.. text-comp getDocument (setDocumentFilter (proxy [DocumentFilter] [] (replace [fb offset len text attrs] (.replace fb offset len (condp = text "\n" (auto-indent-str text-comp offset) text) attrs)) (remove [fb offset len] (.remove fb offset len)) (insertString [fb offset string attr] (.insertString fb offset string attr)))))) ================================================ FILE: src/clooj/navigate.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.navigate (:import (org.fife.ui.rsyntaxtextarea RSyntaxTextArea)) (:require [clooj.utils :as utils])) (defn get-caret-line-number [comp] (.getLineOfOffset comp (.getCaretPosition comp))) (defn move-to-doc-start [comp] (.setCaretPosition comp 0)) (defn move-to-doc-end [comp] (.setCaretPosition comp (.. comp getDocument getLength))) (defn move-to-line-start [comp] (.setCaretPosition comp (.getLineStartOffset comp (get-caret-line-number comp)))) (defn move-to-line-end [comp] (.setCaretPosition comp (let [p (.getLineEndOffset comp (get-caret-line-number comp))] (if (= p (.. comp getDocument getLength)) p (dec p))))) (defn attach-navigation-keys [comp] (utils/attach-action-keys comp ["cmd1 LEFT" #(move-to-line-start comp)] ["cmd1 RIGHT" #(move-to-line-end comp)] ["cmd1 UP" #(move-to-doc-start comp)] ["cmd1 DOWN" #(move-to-doc-end comp)])) ================================================ FILE: src/clooj/project.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.project (:import (java.io File) (java.awt GridLayout) (javax.swing JButton JOptionPane JWindow) (javax.swing.tree DefaultMutableTreeNode DefaultTreeModel TreePath TreeSelectionModel)) (:require [clooj.utils :as utils] [clojure.java.io :as io])) ;; projects tree (declare restart-doc) (def project-set (atom (sorted-set))) (defn save-project-set [] (utils/write-value-to-prefs utils/clooj-prefs "project-set" @project-set)) (defn load-project-set [] (reset! project-set (into (sorted-set) (utils/read-value-from-prefs utils/clooj-prefs "project-set")))) (defn tree-path-to-file [^TreePath tree-path] (when tree-path (try (.. tree-path getLastPathComponent getUserObject getAbsolutePath) (catch Exception e nil)))) ;; loading and saving expanded paths (defn get-row-path [tree row] (tree-path-to-file (. tree getPathForRow row))) (defn get-expanded-paths [tree] (for [i (range (.getRowCount tree)) :when (.isExpanded tree i)] (get-row-path tree i))) (defn save-expanded-paths [tree] (utils/write-value-to-prefs utils/clooj-prefs "expanded-paths" (get-expanded-paths tree))) (defn expand-paths [tree paths] (doseq [i (range) :while (< i (.getRowCount tree))] (when-let [x (some #{(tree-path-to-file (. tree getPathForRow i))} paths)] (.expandPath tree (. tree getPathForRow i))))) (defn load-expanded-paths [tree] (let [paths (utils/read-value-from-prefs utils/clooj-prefs "expanded-paths")] (when paths (expand-paths tree paths)))) ;; loading and saving tree selection (defn save-tree-selection [tree path] (utils/write-value-to-prefs utils/clooj-prefs "tree-selection" (tree-path-to-file path))) (defn path-components "Generates a sequence of the components in a file path." [the-file] (->> (-> the-file io/file .getAbsolutePath (.split File/separator)) (remove empty?) (remove #(= % ".")))) (defn file-ancestor? "In the file tree, returns true if descendant-file is a direct descendant of ancestor-file. Also returns true if the files are the same." [ancestor-file descendant-file] (let [ancestor (path-components ancestor-file) descendant (path-components descendant-file)] (and (every? true? (map = ancestor descendant)) (<= (count ancestor) (count descendant))))) (defn node-children [node] (when-not (.isLeaf node) (for [i (range (.getChildCount node))] (.getChildAt node i)))) (defn path-to-node "Find the tree node corresponding to a particular file path." [tree path] (let [root-node (.. tree getModel getRoot)] (loop [node root-node] (when (and node (not (.isLeaf node))) (when-let [children (node-children node)] (let [closer-node (first (filter #(file-ancestor? (.getUserObject %) path) children))] (when closer-node (if (= (io/file path) (.getUserObject closer-node)) closer-node (recur closer-node))))))))) (defn row-for-path [tree path] (first (for [i (range 1 (.getRowCount tree)) :when (= path (-> tree (.getPathForRow i) .getPath last .getUserObject .getAbsolutePath))] i))) (defn set-tree-selection [tree path] (utils/awt-event (when-let [node (path-to-node tree path)] (let [node-path (.getPath node) paths (map #(.. % getUserObject getAbsolutePath) (rest node-path))] (expand-paths tree paths) (when-let [row (row-for-path tree path)] (.setSelectionRow tree row)))))) (defn load-tree-selection [tree] (let [path (utils/read-value-from-prefs utils/clooj-prefs "tree-selection")] (if (nil? path) false (do (set-tree-selection tree path) true)))) ;;;;;;;;;;;;;;;;;;; (defn get-code-files [dir suffix] (let [dir (io/file dir)] (sort (filter #(.endsWith (.getName %) suffix) (file-seq dir))))) (defn get-temp-file [^File orig] (when orig (io/file (str (.getAbsolutePath orig) "~")))) (defn get-projects "Load projects from preferences, and return a sorted vector." [] (->> (utils/read-value-from-prefs utils/clooj-prefs "project-set") set (sort-by #(.toLowerCase (.getName (io/file %)))) vec)) (defn visible-children "Get a vector of a directory's children, if there are any. Omits hidden and temporary files." [file] (->> (.listFiles file) (remove #(.startsWith (.getName %) ".")) (remove #(.endsWith (.getName %) "~")) vec)) (defn file-name-text "Show a file's name, with *stars* if it is the temp file." [file] (if (.exists (get-temp-file file)) (str "*" (.getName file) "*") (str (.getName file) " "))) (defn file-node "Tree node representing a file (possibly a directory)." [^File file] (let [children (delay (visible-children file))] (proxy [DefaultMutableTreeNode] [file] (getChildAt [i] (file-node (@children i))) (getChildCount [] (count @children)) (toString [] (file-name-text file)) (isLeaf [] (not (.isDirectory file)))))) (defn root-node "The root tree node, given a vector of project locations." [projects] (proxy [DefaultMutableTreeNode] [] (getChildAt [i] (file-node (io/file (nth projects i)))) (getChildCount [] (count projects)) (toString [] "root"))) (defn file-tree-model [projects] (DefaultTreeModel. (root-node projects) false)) (defn update-project-tree [tree] (let [model (file-tree-model (vec @project-set))] (utils/awt-event ;(time (do (.setModel tree model) (save-project-set) (load-expanded-paths tree) (load-tree-selection tree) (save-expanded-paths tree)))) ;)) (defn get-selected-file-path [app] (when-let [tree-path (-> app :docs-tree .getSelectionPaths first)] (-> tree-path .getLastPathComponent .getUserObject .getAbsolutePath))) (defn get-selected-namespace [tree] (-> tree .getSelectionPaths first .getLastPathComponent .getUserObject .toString (.replace ".clj" "") (.replace "/" "."))) (defn get-selected-projects [app] (let [tree (app :docs-tree) selections (.getSelectionPaths tree)] (for [selection selections] (-> selection .getPath second .getUserObject)))) (defn add-project [app project-path] (swap! project-set conj project-path)) (defn rename-project [app] (when-let [dir (utils/choose-file (app :frame) "Move/rename project directory" "" false)] (let [old-project (first (get-selected-projects app))] (if (.renameTo (io/file old-project) dir) (do (swap! project-set #(-> % (disj old-project) (conj (.getAbsolutePath dir)))) (update-project-tree (:docs-tree app))) (JOptionPane/showMessageDialog nil "Unable to move project."))))) (defn remove-selected-project [app] (apply swap! project-set disj (map #(.getAbsolutePath %) (get-selected-projects app))) (update-project-tree (app :docs-tree))) ================================================ FILE: src/clooj/protocols.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.protocols) ;; Repl protocol (defprotocol Repl (evaluate [this code] "Evaluate code (a string).") (close [this] "Stop the repl instance.")) ================================================ FILE: src/clooj/repl/external.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.repl.external (:import (java.net URL URLDecoder) (java.io File PrintWriter) (java.util.concurrent LinkedBlockingQueue)) (:require [clojure.java.io :as io] [clooj.utils :as utils] [clooj.help :as help] [clooj.protocols :as protocols] [clooj.repl.lein :as lein] [clj-inspector.jars :as jars])) (defn own-clojure-jar "Locate the clojure jar being used by clooj (last resort)." [] (let [class-loader (.getClassLoader clojure.lang.RT)] (when-let [url (.findResource class-loader "clojure/lang/RT.class")] (-> url .getFile URL. .getFile URLDecoder/decode (.split "!/") first)))) (defn jar-contains-class? "Does the jar contain a particular class file? Specify the classname in a string, e.g. \"clojure.lang.RT\"" [jar classname] (let [entries (jars/get-entries-in-jar jar) filenames (map #(.getName %) entries) desired (str (.replace classname "." "/") ".class")] (not (nil? (some #(= % desired) filenames))))) (defn clojure-jar-location "Find the location of a clojure jar in a project." [^String project-path] (let [lib-dir (str project-path "/lib") jars (filter #(.contains (.getName %) "clojure") (jars/jar-files lib-dir))] (first (filter #(jar-contains-class? % "clojure.lang.RT") jars)))) (defn repl-classpath-items "Figures out the necessary pieces for a viable classpath given a particular project directory." [project-path] (try (lein/lein-classpath-items project-path) (catch Exception e [(or (clojure-jar-location project-path) (own-clojure-jar)) (str project-path "/lib/*") (str project-path "/src")]))) (defn java-binary "Returns the fully-qualified path of the java binary." [] (str (System/getProperty "java.home") File/separator "bin" File/separator "java")) (defn repl-process "Start an external repl process by running clojure.main." [project-path classpath-items] (let [classpath-str (apply str (interpose File/pathSeparatorChar classpath-items))] (.start (doto (ProcessBuilder. [(java-binary) "-cp" classpath-str "clojure.main"]) (.redirectErrorStream true) (.directory (io/file (or project-path "."))))))) (defn launch-repl "Launch an outside process with a clojure repl." [project-path classpath-items result-writer] (let [process (repl-process project-path classpath-items) input-writer (-> process .getOutputStream (PrintWriter. true)) is (.getInputStream process)] (future (utils/copy-input-stream-to-writer is result-writer)); :buffer-size 10)) {:input-writer input-writer :project-path project-path :process process :classpath classpath-items :result-writer result-writer})) (defn evaluate-code "Evaluate some code in the repl specified by repl-map." [repl-map code] (binding [*out* (:input-writer repl-map)] (println code) (.flush *out*))) (defn close "Close the repl specified in the repl-map." [{:keys [input-writer result-writer process] :as repl-map}] (doto input-writer .flush .close) (.flush result-writer) (.destroy process)) (defn repl "Returns a repl, based at project-path, where outputs are printed to result-writer." [project-path classpath-items result-writer] (let [repl-map (launch-repl project-path classpath-items result-writer)] (reify protocols/Repl (evaluate [this code] (evaluate-code repl-map code)) (close [this] (close repl-map)) (toString [this] (str "Repl with classpath" (:classpath repl-map)))))) ================================================ FILE: src/clooj/repl/lein.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.repl.lein (:import (java.io BufferedReader File InputStreamReader)) (:require [nrepl.core :as nrepl] [clojure.java.io :as io] [clooj.protocols :as protocols] [clooj.utils :as utils])) ; Documentation for nrepl at https://github.com/clojure/tools.nrepl ;; nrepl handling (defn connect-nrepl "Connect to an nrepl port. Return a user session and a control session." [port out-writer] (let [conn (nrepl/connect :port port) client (nrepl/client conn 1000)] {:port port :connection conn :client client :session (nrepl/new-session client) :out out-writer})) (defn disconnect-nrepl "Disconnects from an nrepl port." [{:keys [connection]}] (.close connection)) (defn nrepl-eval "Evaluate nrepl code." [nrepl-connection code] (let [results (nrepl/message (:client nrepl-connection) {:op :eval :code (str "(do " code ")") :session :session}) promised-value (promise)] (println results) (future (doseq [result results] (when-let [out (:out result)] (binding [*out* (:out nrepl-connection)] (locking *out* (print out)))) (when-let [value (:value result)] (deliver promised-value (read-string value))))) @promised-value)) (defn nrepl "Connects to an nrepl, returning a Repl instance." [port out-writer] (let [nrepl (connect-nrepl port out-writer)] (reify protocols/Repl (evaluate [_ code] (nrepl-eval nrepl code)) (close [_] (disconnect-nrepl nrepl))))) ;; lein repl (defn lein-command "Issue a leiningen command in project-path." [project-path cmd] (-> (doto (ProcessBuilder. ["lein" cmd]) (.redirectErrorStream false) (.directory (io/file (or project-path ".")))) .start)) (defn lein-repl-process "Start an external lein repl process." [project-path] (lein-command project-path "repl")) (defn lein-nrepl-port-number "Takes the first line printed to stdout from a lein repl process and returns the nrepl port number." [out-line] (when-let [port-str (second (re-find #"port\s(\d+)" out-line))] (Long/parseLong port-str))) (defn lein-repl-start "Start an external lein repl process, and connect to it via nrepl." [project-path out-writer] (let [process (lein-repl-process project-path) lines (line-seq (utils/process-reader process)) port (lein-nrepl-port-number (first (drop-while nil? lines)))] {:nrepl (nrepl port out-writer) :process process})) (defn lein-repl-stop "Disconnect from the nrepl connection and destroy the lein repl process." [{:keys [process nrepl]}] (.close nrepl) (.destroy process)) (defn lein-repl "Creates and connect to a lein repl, returning a Repl instance. The repl's output is printed to out-writer." [project-path out-writer] (println "lein-repl.") (let [repl (lein-repl-start project-path out-writer)] (reify protocols/Repl (evaluate [_ code] (.evaluate (:nrepl repl) code)) (close [_] (lein-repl-stop repl))))) (defn lein-classpath-items "Returns a string containing the lein classpath." [project-path] (-> (lein-command project-path "classpath") utils/process-reader line-seq first (.split File/pathSeparator))) ================================================ FILE: src/clooj/repl/main.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.repl.main (:import (java.io BufferedReader BufferedWriter InputStreamReader File PipedReader PipedWriter PrintWriter Writer StringReader PushbackReader) (clojure.lang LineNumberingPushbackReader) (java.awt Rectangle) (java.net URL URLClassLoader URLDecoder) (java.util.concurrent LinkedBlockingQueue)) (:require [clj-inspector.jars :as jars] [clojure.string :as string] [nrepl.core :as nrepl] [clojure.java.io :as io] [clooj.brackets :as brackets] [clooj.help :as help] [clooj.project :as project] [clooj.repl.external :as external] [clooj.repl.lein :as lein] [clooj.protocols :as protocols] [clooj.utils :as utils])) #_{:clj-kondo/ignore [:use]} (use 'clojure.java.javadoc) (def repl-history {:items (atom nil) :pos (atom 0)}) ;; utils (defn tokens "Finds all the tokens in a given string." [text] (re-seq #"[\w\d/\-\.\?\+\!\*\$\>\<]+" text)) (defn namespaces-from-code "Take tokens from text and extract namespace symbols." [text] (->> text tokens (filter #(.contains % "/")) (map #(.split % "/")) (map first) (map #(when-not (empty? %) (symbol %))) (remove nil?))) (defn is-eof-ex? [throwable] (and (instance? clojure.lang.LispReader$ReaderException throwable) (or (.startsWith (.getMessage throwable) "java.lang.Exception: EOF while reading") (.startsWith (.getMessage throwable) "java.io.IOException: Write end dead")))) (defn get-project-path [app] (when-let [repl (:repl app)] (-> repl deref :project-path))) (defn initialize-repl [repl] (.evaluate repl (str "(do" (utils/local-clj-source "clooj/cemerick/pomegranate.clj") (utils/local-clj-source "clooj/repl/remote.clj") "(clooj.repl.remote/repl)" ")" ))) (defn replace-first [coll x] (cons x (next coll))) (defn update-repl-history [app] (swap! (:items repl-history) replace-first (utils/get-text-str (app :repl-in-text-area)))) (defn read-string-at [source-text start-line] `(let [sr# (java.io.StringReader. (str (apply str (repeat ~start-line "\n")) ~source-text)) rdr# (clojure.lang.LineNumberingPushbackReader. sr#)] (take-while #(not= % :EOF_REACHED) (repeatedly #(try (read rdr#) (catch Exception e# :EOF_REACHED)))))) (defn cmd-attach-file-and-line [cmd file line classpaths] (let [read-string-code (read-string-at cmd line) short-file (last (.split file "/")) namespaces (namespaces-from-code cmd)] ;(println namespaces) (pr-str `(do (dorun (map #(try (clooj.cemerick.pomegranate/add-classpath %) (catch Exception e# (println e#))) '~classpaths)) (dorun (map #(try (require %) (catch Exception _#)) '~namespaces)) (binding [*source-path* ~short-file *file* ~file] (last (map eval ~read-string-code))))))) (defn print-to-repl [app cmd-str silent?] (when-let [repl @(app :repl)] (.evaluate repl (if silent? (str "(clooj.repl.remote/silent" cmd-str ")") cmd-str)))) (defn send-to-repl ([app cmd silent?] (send-to-repl app cmd "NO_SOURCE_PATH" 0 silent?)) ([app cmd file line silent?] (let [cmd-ln (str cmd \newline)] (when-not silent? (utils/append-text (app :repl-out-text-area) cmd-ln)) (print-to-repl app cmd silent?) (when-not silent? (when (not= cmd (second @(:items repl-history))) (swap! (:items repl-history) replace-first cmd) (swap! (:items repl-history) conj "")) (reset! (:pos repl-history) 0))))) (defn relative-file [app] (let [prefix (str (get-project-path app) File/separator "src" File/separator)] (utils/when-lets [f @(app :file) path (.getAbsolutePath f)] (subs path (count prefix))))) (defn selected-region [ta] (if-let [text (.getSelectedText ta)] {:text text :start (.getSelectionStart ta) :end (.getSelectionEnd ta)} (let [[a b] (brackets/find-line-group ta)] (when (and a b (< a b)) {:text (.. ta getDocument (getText a (- b a))) :start a :end b})))) (defn send-selected-to-repl [app] (let [ta (app :doc-text-area) region (selected-region ta) txt (:text region)] (if-not txt (.setText (app :arglist-label) "Malformed expression") (let [line (.getLineOfOffset ta (:start region))] (send-to-repl app txt (relative-file app) line false))))) (defn send-doc-to-repl [app] (let [text (->> app :doc-text-area .getText)] (utils/append-text (app :repl-out-text-area) "Evaluating file...") (send-to-repl app text (relative-file app) 0 true))) (defn make-repl-writer [ta-out] (-> (proxy [Writer] [] (write ([char-array offset length] ;(println "char array:" (apply str char-array) (count char-array)) (utils/append-text ta-out (apply str char-array))) ([t] ;(println "t:" t) (if (= Integer (type t)) (utils/append-text ta-out (str (char t))) (utils/append-text ta-out (apply str t))))) (flush []) (close [] nil)) (PrintWriter. true))) (defn update-repl-in [app] (when (pos? (count @(:items repl-history))) (.setText (:repl-in-text-area app) (nth @(:items repl-history) @(:pos repl-history))))) (defn show-previous-repl-entry [app] (when (zero? @(:pos repl-history)) (update-repl-history app)) (swap! (:pos repl-history) #(min (dec (count @(:items repl-history))) (inc %))) (update-repl-in app)) (defn show-next-repl-entry [app] (when (pos? @(:pos repl-history)) (swap! (:pos repl-history) #(Math/max 0 (dec %))) (update-repl-in app))) (defn get-file-ns [app] (try (when-let [sexpr (read-string (.getText (app :doc-text-area)))] (when (= 'ns (first sexpr)) (str (second sexpr)))) (catch Exception e))) (defn start-repl [app project-path] (let [project-path (if (utils/file-exists? project-path) project-path nil)] (utils/append-text (app :repl-out-text-area) (str "\n=== Starting new REPL at " project-path " ===\n")) (let [classpath-items ;(lein/lein-classpath-items project-path) (external/repl-classpath-items project-path) repl ;(lein/lein-repl project-path (app :repl-out-writer)) (external/repl project-path classpath-items (app :repl-out-writer)) ] (initialize-repl repl) (help/update-var-maps! project-path classpath-items) (reset! (:repl app) repl)))) (defn stop-repl [app] (utils/append-text (app :repl-out-text-area) "\n=== Shutting down REPL ===") (when-let [repl @(:repl app)] (.close repl))) (defn apply-namespace-to-repl [app] (when-not @(:repl app) (start-repl app (first (project/get-selected-projects app)))) (when-let [current-ns (get-file-ns app)] (send-to-repl app (str "(ns " current-ns ")") true))) (defn restart-repl [app project-path] (stop-repl app) (start-repl app project-path) (apply-namespace-to-repl app)) (defn add-repl-input-handler [app] (let [ta-in (app :repl-in-text-area) get-caret-pos #(.getCaretPosition ta-in) ready #(let [caret-pos (get-caret-pos) txt (.getText ta-in) trim-txt (string/trimr txt)] (and (pos? (.length trim-txt)) (<= (.length trim-txt) caret-pos) (= -1 (first (brackets/find-enclosing-brackets txt caret-pos))))) submit #(when-let [txt (.getText ta-in)] (send-to-repl app txt false) (.setText ta-in "")) at-top #(zero? (.getLineOfOffset ta-in (get-caret-pos))) at-bottom #(= (.getLineOfOffset ta-in (get-caret-pos)) (.getLineOfOffset ta-in (.. ta-in getText length))) prev-hist #(show-previous-repl-entry app) next-hist #(show-next-repl-entry app)] (utils/attach-child-action-keys ta-in ["UP" at-top prev-hist] ["DOWN" at-bottom next-hist] ["ENTER" ready submit]) (utils/attach-action-keys ta-in ["cmd1 UP" prev-hist] ["cmd1 DOWN" next-hist] ["cmd1 ENTER" submit]))) (defn print-stack-trace [app] (send-to-repl app "(when *e (.printStackTrace *e))" true)) ================================================ FILE: src/clooj/repl/output.clj ================================================ (ns clooj.repl.output (:import (java.awt Point Rectangle) (java.util.concurrent.atomic AtomicBoolean AtomicInteger) (javax.swing JFrame JScrollPane JSplitPane JSlider JTextArea SwingUtilities) (javax.swing.event DocumentEvent DocumentListener))) (defn end-position "Finds the end position of an insert or change in a document as reported in a DocumentEvent instance." [^DocumentEvent document-event] (+ (.getOffset document-event) (.getLength document-event))) (defn tailing-scroll-pane "Embeds the given JTextArea in a JScrollPane that scrolls to the bottom whenever text is inserted or appended." [text-area] (let [scroll-offset (AtomicInteger. -1) scroll-pane (proxy [JScrollPane] [text-area] (paintComponent [graphics] (let [offset (.getAndSet scroll-offset -1)] (when (not= -1 offset) (.. this getVerticalScrollBar (setValue (.y (.modelToView text-area offset)))))) (proxy-super paintComponent graphics))) set-scroll-offset (fn [e] (.set scroll-offset (end-position e)) (.repaint scroll-pane))] (.. text-area getDocument (addDocumentListener (proxy [DocumentListener] [] (changedUpdate [e] (set-scroll-offset e)) (insertUpdate [e] (set-scroll-offset e)) (removeUpdate [e])))) scroll-pane)) ;; manual tests (defn test-text-area "Creates a JTextArea, shows it in a JFrame with a JSlider above it. Returns the text-area instance." [] (let [text-area (JTextArea.) scroll-pane (tailing-scroll-pane text-area) ;[text-area scroll-pane] (tailing-text-area) frame (JFrame. "test") document (.getDocument text-area) slider (JSlider. 0 100) split-pane (JSplitPane. JSplitPane/VERTICAL_SPLIT true slider scroll-pane)] (doto (.getContentPane frame) (.add split-pane)) (doto frame .pack (.setBounds 30 30 400 400) .show) text-area )) (defn write-lines "Write n lines of text (positive integers) in the text-area" [text-area n] (dotimes [i n] (.append text-area (str i "\n")))) ================================================ FILE: src/clooj/repl/remote.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.repl.remote (:import (java.io StringReader)) (:require [clojure.main :as m] [clojure.pprint :as pp])) (def silence (atom false)) (defmacro silent "Silently evaluate code in a repl such that it is omitted from the *1,*2,*3 history." [& body] `(do (reset! clooj.repl.remote/silence true) ~@body (let [last-val# *1] (set! *1 *2) (set! *2 *3) last-val#))) (defn read-code-at "Read some text as code, as though it were located at a particular line number." [text line] (read (proxy [clojure.lang.LineNumberingPushbackReader] [(StringReader. (str "(do " text ")"))] (getLineNumber [] (+ -1 line (proxy-super getLineNumber)))))) (defn eval-code-at "Evaluate some text as code, as though it were located in a given file at a particular line number." [text file line] (binding [*file* file] (eval (read-code-at text line)))) (defn repl "Starts a REPL (for nesting in a primitive REPL) that prints nicely and suppresses silent evaluations." [] (m/repl :print (fn [x] (if @silence (do (reset! silence false) (println)) (if (var? x) (println x) (pp/pprint x)))) :prompt #(do (m/repl-prompt) (.flush *out*)))) ================================================ FILE: src/clooj/search.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.search (:import (java.awt Color) (java.util.regex Pattern Matcher)) (:require [clooj.highlighting :as highlighting] [clooj.utils :as utils])) (defn configure-search [match-case use-regex] (bit-or Pattern/CANON_EQ Pattern/UNICODE_CASE (if match-case 0 Pattern/CASE_INSENSITIVE) (if use-regex 0 Pattern/LITERAL))) (defn find-all-in-string [s t match-case use-regex] (try (when (pos? (.length t)) (let [p (Pattern/compile t (configure-search match-case use-regex)) m (re-matcher p s)] (loop [positions []] (if (.find m) (recur (conj positions [(.start m) (.end m)] ) ) positions)))) (catch Exception _ []))) (defn highlight-found [text-comp posns] (doall (map #(highlighting/highlight text-comp (first %) (second %) Color/YELLOW) posns))) (defn next-item [cur-pos posns] (or (first (drop-while #(> cur-pos (first %)) posns)) (first posns))) (defn prev-item [cur-pos posns] (or (first (drop-while #(< cur-pos (first %)) (reverse posns))) (last posns))) (def search-highlights (atom nil)) (def current-pos (atom 0)) (defn update-find-highlight [sta app back] (let [dta (:doc-text-area app) match-case (.isSelected (:search-match-case-checkbox app)) use-regex (.isSelected (:search-regex-checkbox app)) posns (find-all-in-string (utils/get-text-str dta) (utils/get-text-str sta) match-case use-regex)] (highlighting/remove-highlights dta @search-highlights) (if (pos? (count posns)) (let [selected-pos (if back (prev-item (dec @current-pos) posns) (next-item @current-pos posns)) posns (remove #(= selected-pos %) posns) pos-start (first selected-pos) pos-end (second selected-pos)] (.setBackground sta Color/WHITE) (doto dta (.setSelectionStart pos-end) (.setSelectionEnd pos-end)) (reset! current-pos pos-start) (reset! search-highlights (conj (highlight-found dta posns) (highlighting/highlight dta pos-start pos-end (.getSelectionColor dta)))) (utils/scroll-to-pos dta pos-start)) (.setBackground sta Color/PINK)))) (defn start-find [app] (let [sta (:search-text-area app) case-checkbox (:search-match-case-checkbox app) regex-checkbox (:search-regex-checkbox app) close-button (:search-close-button app) arg (:arglist-label app) dta (:doc-text-area app) sel-text (.getSelectedText dta)] (.setVisible arg false) (doto sta (.setVisible true) (.requestFocus) (.selectAll)) (.setVisible case-checkbox true) (.setVisible regex-checkbox true) (.setVisible close-button true) (when (seq sel-text) (.setText sta sel-text)))) (defn stop-find [app] (let [sta (app :search-text-area) dta (app :doc-text-area) case-checkbox (:search-match-case-checkbox app) regex-checkbox (:search-regex-checkbox app) close-button (:search-close-button app) arg (app :arglist-label)] (.setVisible arg true) (.setVisible sta false) (.setVisible case-checkbox false) (.setVisible regex-checkbox false) (.setVisible close-button false) (highlighting/remove-highlights dta @search-highlights) (reset! search-highlights nil) (reset! current-pos 0))) (defn escape-find [app] (stop-find app) (.requestFocus (:doc-text-area app))) (defn highlight-step [app back] (let [doc-text-area (:doc-text-area app) search-text-area (:search-text-area app)] (start-find app) (when-not back (swap! current-pos inc)) (update-find-highlight search-text-area app back))) ================================================ FILE: src/clooj/settings.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.settings (:import (javax.swing JFrame JTabbedPane JLabel JPanel JComboBox Box JTextField JTextArea BoxLayout SpringLayout JButton JCheckBox) (java.awt Font GraphicsEnvironment Dimension) (java.awt.image BufferedImage) (javax.swing.event DocumentListener) (java.awt.event ActionListener ItemListener ItemEvent)) (:require [clooj.utils :as utils])) (def settings (atom nil)) (defn combo-box [items default-item change-fun] (doto (JComboBox. (into-array items)) (.setSelectedItem default-item) (.addActionListener (reify ActionListener (actionPerformed [_ e] (change-fun (.. e getSource getSelectedItem))))))) (defn text-field [default-value change-fun] (let [tf (JTextField. (str default-value))] (.addDocumentListener (.getDocument tf) (reify DocumentListener (insertUpdate [_ e] (change-fun (.getText tf))) (removeUpdate [_ e] (change-fun (.getText tf))) (changedUpdate [_ e]))) tf)) (defn check-box [text checked? change-fun] (doto (JCheckBox. text checked?) (.addItemListener (reify ItemListener (itemStateChanged [_ e] (change-fun (= (.getStateChange e) ItemEvent/SELECTED))))))) (defn font-panel [] (let [graphics-object (delay (.createGraphics (BufferedImage. 1 1 BufferedImage/TYPE_INT_ARGB))) monospaced? (fn [font] (let [g @graphics-object m (.getFontMetrics g font)] (apply == (map #(.charWidth m %) [\m \n \. \M \-])))) get-all-font-names (fn [] (.. GraphicsEnvironment getLocalGraphicsEnvironment getAvailableFontFamilyNames)) get-all-fonts-12 (fn [] (map #(Font. % Font/PLAIN 12) (get-all-font-names))) get-monospaced-font-names (fn [] (map #(.getName %) (filter monospaced? (get-all-fonts-12)))) get-necessary-fonts (fn [] (if (:show-only-monospaced-fonts @settings) (get-monospaced-font-names) (get-all-font-names))) example-text-area (doto (JTextArea. "abcdefghijklmnopqrstuvwxyz 0123456789 (){}[]\nABCDEFGHIJKLMNOPQRSTUVWXYZ +-*/= .,;:!? #&$%@|^") (.setFont (Font. (:font-name @settings) Font/PLAIN (:font-size @settings)))) example-pane (doto (JPanel. (SpringLayout.)) (.add example-text-area)) font-box (combo-box (get-necessary-fonts) (:font-name @settings) #(do (swap! settings assoc :font-name %) (.setFont example-text-area (Font. % Font/PLAIN (:font-size @settings))))) size-box (combo-box (range 5 49) (:font-size @settings) #(do (swap! settings assoc :font-size %) (.setFont example-text-area (Font. (:font-name @settings) Font/PLAIN %)))) monospaced-check-box (check-box "Show only monospaced fonts" (:show-only-monospaced-fonts @settings) #(do (swap! settings assoc :show-only-monospaced-fonts %) (doto font-box (.setModel (.getModel (JComboBox. (into-array (get-necessary-fonts))))) (.setSelectedItem (:font-name @settings))))) controls-pane (JPanel.) font-pane (JPanel.)] (utils/constrain-to-parent example-text-area :n 20 :w 15 :s -15 :e -15) (doto controls-pane (.setLayout (BoxLayout. controls-pane BoxLayout/X_AXIS)) (.add (Box/createRigidArea (Dimension. 20 0))) (.add (JLabel. "Font:")) (.add (Box/createRigidArea (Dimension. 25 0))) (.add font-box) (.add (Box/createRigidArea (Dimension. 25 0))) (.add (JLabel. "Size:")) (.add (Box/createRigidArea (Dimension. 25 0))) (.add size-box) (.add (Box/createHorizontalGlue))) (doto font-pane (.setLayout (BoxLayout. font-pane BoxLayout/Y_AXIS)) (.add controls-pane) (.add monospaced-check-box) (.add example-pane)))) (defn editor-options-panel [] (let [options-pane (JPanel.)] (doto options-pane (.setLayout (BoxLayout. options-pane BoxLayout/Y_AXIS)) (.add (check-box "Wrap lines in source editor" (:line-wrap-doc @settings) #(swap! settings assoc :line-wrap-doc %))) (.add (check-box "Wrap lines in repl output" (:line-wrap-repl-out @settings) #(swap! settings assoc :line-wrap-repl-out %))) (.add (check-box "Wrap lines in repl input" (:line-wrap-repl-in @settings) #(swap! settings assoc :line-wrap-repl-in %)))))) (defmacro tabs [& elements] `(doto (JTabbedPane.) ~@(map #(list '.addTab (first %) (second %)) elements))) (defn make-settings-window [app apply-fn] (let [bounds (.getBounds (:frame app)) x (+ (.x bounds) (/ (.width bounds) 2)) y (+ (.y bounds) (/ (.height bounds) 2)) settings-frame (JFrame. "Settings") button-pane (JPanel.)] (doto button-pane (.setLayout (BoxLayout. button-pane BoxLayout/X_AXIS)) (.add (utils/create-button "OK" #(do (apply-fn app @settings) (.dispose settings-frame)))) (.add (utils/create-button "Apply" #(apply-fn app @settings))) (.add (utils/create-button "Cancel" #(.dispose settings-frame)))) (doto settings-frame (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE) (.setLayout (BoxLayout. (.getContentPane settings-frame) BoxLayout/Y_AXIS)) (.setBounds (- x 250) (- y 250) 500 500) (.add (tabs ["Font" (font-panel)] ["Editor options" (editor-options-panel)])) (.add (Box/createRigidArea (Dimension. 0 25))) (.add button-pane)))) (defn show-settings-window [app apply-fn] (reset! settings @(:settings app)) (.show (make-settings-window app apply-fn))) ================================================ FILE: src/clooj/utils.clj ================================================ ; Copyright (c) 2011-2013, Arthur Edelstein ; All rights reserved. ; Eclipse Public License 1.0 ; arthuredelstein@gmail.com (ns clooj.utils (:require [clojure.string :as string]) (:import (java.awt FileDialog Point Window) (java.awt.event ActionListener MouseAdapter) (java.util.prefs Preferences) (java.security MessageDigest) (java.io ByteArrayInputStream ByteArrayOutputStream File FilenameFilter BufferedReader InputStreamReader ObjectInputStream ObjectOutputStream OutputStream PrintStream) (javax.swing AbstractAction JButton JFileChooser JMenu JMenuItem BorderFactory JOptionPane JSplitPane KeyStroke SpringLayout SwingUtilities) (javax.swing.event CaretListener DocumentListener UndoableEditListener) (javax.swing.undo UndoManager))) ;; general (defmacro do-when [f & args] (let [args_ args] `(when (and ~@args_) (~f ~@args_)))) (defmacro when-lets [bindings & body] (assert (vector? bindings)) (let [n (count bindings)] (assert (zero? (mod n 2))) (assert (<= 2 n)) (if (= 2 n) `(when-let ~bindings ~@body) (let [[a b] (map vec (split-at 2 bindings))] `(when-let ~a (when-lets ~b ~@body)))))) (defn count-while [pred coll] (count (take-while pred coll))) (defn remove-nth [s n] (lazy-cat (take n s) (drop (inc n) s))) (defmacro awt-event [& body] `(SwingUtilities/invokeLater (fn [] (try ~@body (catch Throwable t# (.printStackTrace t#)))))) (defmacro gen-map [& args] (let [kw (map keyword args)] (zipmap kw args))) (defn class-for-name "Returns true if a class represented by class-name can be found by the class loader." [class-name] (try (Class/forName class-name) (catch Throwable _ nil))) ;; preferences ;; define a UUID for clooj preferences (def clooj-prefs (.. Preferences userRoot (node "clooj") (node "c6833c87-9631-44af-af83-f417028ea7aa"))) (defn partition-str [n s] (let [l (.length s)] (for [i (range 0 l n)] (.substring s i (Math/min l (+ (int i) (int n))))))) (def pref-max-bytes (* 3/4 Preferences/MAX_VALUE_LENGTH)) (defn write-value-to-prefs "Writes a pure clojure data structure to Preferences object." [prefs key value] (let [chunks (partition-str pref-max-bytes (with-out-str (pr value))) node (. prefs node key)] (.clear node) (doseq [i (range (count chunks))] (. node put (str i) (nth chunks i))))) (defn read-value-from-prefs "Reads a pure clojure data structure from Preferences object." [prefs key] (when-not (.endsWith key "/") (let [node (.node prefs key) s (apply str (for [i (range (count (. node keys)))] (.get node (str i) nil)))] (when (and s (pos? (.length s))) (read-string s))))) (defn write-obj-to-prefs "Writes a java object to a Preferences object." [prefs key obj] (let [bos (ByteArrayOutputStream.) os (ObjectOutputStream. bos) node (.node prefs key)] (.writeObject os obj) (. node putByteArray "0" (.toByteArray bos)))) (defn read-obj-from-prefs "Reads a java object from a Preferences object." [prefs key] (let [node (.node prefs key) bis (ByteArrayInputStream. (. node getByteArray "0" nil)) os (ObjectInputStream. bis)] (.readObject os))) ;; identify OS (defn get-os [] (string/lower-case (System/getProperty "os.name"))) (def is-win (memoize #(not (neg? (.indexOf (get-os) "win"))))) (def is-mac (memoize #(not (neg? (.indexOf (get-os) "mac"))))) (def is-unix (memoize #(not (and (neg? (.indexOf (get-os) "nix")) (neg? (.indexOf (get-os) "nux")))))) ;; swing layout (defn put-constraint [comp1 edge1 comp2 edge2 dist] (let [edges {:n SpringLayout/NORTH :w SpringLayout/WEST :s SpringLayout/SOUTH :e SpringLayout/EAST}] (.. comp1 getParent getLayout (putConstraint (edges edge1) comp1 dist (edges edge2) comp2)))) (defn put-constraints [comp & args] (let [args (partition 3 args) edges [:n :w :s :e]] (dorun (map #(apply put-constraint comp %1 %2) edges args)))) (defn constrain-to-parent "Distance from edges of parent comp args" [comp & args] (apply put-constraints comp (flatten (map #(cons (.getParent comp) %) (partition 2 args))))) ;; text components (defn get-line-text [text-pane line] (let [start (.getLineStartOffset text-pane line) length (- (.getLineEndOffset text-pane line) start)] (.. text-pane getDocument (getText start length)))) (defn append-text ([text-pane text scroll-to-end?] (append-text text-pane text)) ([text-pane text] (.append text-pane text))) (defn get-coords [text-comp offset] (let [row (.getLineOfOffset text-comp offset) col (- offset (.getLineStartOffset text-comp row))] {:row row :col col})) (defn get-caret-coords [text-comp] (get-coords text-comp (.getCaretPosition text-comp))) (defn add-text-change-listener "Executes f whenever text is changed in text component." [text-comp f] (.addDocumentListener (.getDocument text-comp) (reify DocumentListener (insertUpdate [this evt] (f text-comp)) (removeUpdate [this evt] (f text-comp)) (changedUpdate [this evt])))) (defn remove-text-change-listeners [text-comp] (let [d (.getDocument text-comp)] (doseq [l (.getDocumentListeners d)] (.removeDocumentListener d l)))) (defn get-text-str [text-comp] (let [doc (.getDocument text-comp)] (.getText doc 0 (.getLength doc)))) (defn add-caret-listener [text-comp f] (.addCaretListener text-comp (reify CaretListener (caretUpdate [this evt] (f text-comp))))) (defn set-selection [text-comp start end] (doto text-comp (.setSelectionStart start) (.setSelectionEnd end))) (defn scroll-to-pos [text-area offset] (let [r (.modelToView text-area offset) v (.getParent text-area) l (.. v getViewSize height) h (.. v getViewRect height)] (when r (.setViewPosition v (Point. 0 (min (- l h) (max 0 (- (.y r) (/ h 2))))))))) (defn scroll-to-line [text-comp line] (let [text (.getText text-comp) pos (inc (.length (string/join "\n" (take (dec line) (string/split text #"\n")))))] (.setCaretPosition text-comp pos) (scroll-to-pos text-comp pos))) (defn scroll-to-caret [text-comp] (scroll-to-pos text-comp (.getCaretPosition text-comp))) (defn focus-in-text-component [text-comp] (.requestFocusInWindow text-comp) (scroll-to-caret text-comp)) (defn get-selected-lines [text-comp] (let [row1 (.getLineOfOffset text-comp (.getSelectionStart text-comp)) row2 (inc (.getLineOfOffset text-comp (.getSelectionEnd text-comp)))] (doall (range row1 row2)))) (defn get-selected-line-starts [text-comp] (map #(.getLineStartOffset text-comp %) (reverse (get-selected-lines text-comp)))) (defn insert-in-selected-row-headers [text-comp txt] (awt-event (let [starts (get-selected-line-starts text-comp) document (.getDocument text-comp)] (dorun (map #(.insertString document % txt nil) starts))))) (defn remove-from-selected-row-headers [text-comp txt] (awt-event (let [len (count txt) document (.getDocument text-comp)] (doseq [start (get-selected-line-starts text-comp)] (when (= (.getText (.getDocument text-comp) start len) txt) (.remove document start len)))))) (defn comment-out [text-comp] (insert-in-selected-row-headers text-comp ";")) (defn uncomment-out [text-comp] (remove-from-selected-row-headers text-comp ";")) (defn toggle-comment [text-comp] (if (= (.getText (.getDocument text-comp) (first (get-selected-line-starts text-comp)) 1) ";") (uncomment-out text-comp) (comment-out text-comp))) (defn indent [text-comp] (when (.isFocusOwner text-comp) (insert-in-selected-row-headers text-comp " "))) (defn unindent [text-comp] (when (.isFocusOwner text-comp) (remove-from-selected-row-headers text-comp " "))) ;; other gui (defn make-split-pane [comp1 comp2 horizontal divider-size resize-weight] (doto (JSplitPane. (if horizontal JSplitPane/HORIZONTAL_SPLIT JSplitPane/VERTICAL_SPLIT) true comp1 comp2) (.setResizeWeight resize-weight) (.setOneTouchExpandable false) (.setBorder (BorderFactory/createEmptyBorder)) (.setDividerSize divider-size))) ;; keys (defn get-keystroke [key-shortcut] (KeyStroke/getKeyStroke (-> key-shortcut (.replace "cmd1" (if (is-mac) "meta" "ctrl")) (.replace "cmd2" (if (is-mac) "ctrl" "alt"))))) ;; actions (defn attach-child-action-key "Maps an input-key on a swing component to an action, such that action-fn is executed when pred function is true, but the parent (default) action when pred returns false." [component input-key pred action-fn] (let [im (.getInputMap component) am (.getActionMap component) input-event (get-keystroke input-key) parent-action (when-let [tag (.get im input-event)] (.get am tag)) child-action (proxy [AbstractAction] [] (actionPerformed [e] (if (pred) (action-fn) (when parent-action (.actionPerformed parent-action e))))) uuid (str (random-uuid))] (.put im input-event uuid) (.put am uuid child-action))) (defn attach-child-action-keys [comp & items] (run! #(apply attach-child-action-key comp %) items)) (defn attach-action-key "Maps an input-key on a swing component to an action-fn." [component input-key action-fn] (attach-child-action-key component input-key (constantly true) action-fn)) (defn attach-action-keys "Maps input keys to action-fns." [comp & items] (run! #(apply attach-action-key comp %) items)) ;; buttons (defn create-button [text fn] (doto (JButton. text) (.addActionListener (reify ActionListener (actionPerformed [_ _] (fn)))))) ;; menus (defn add-menu-item ([menu item-name key-mnemonic key-accelerator response-fn] (let [menu-item (JMenuItem. item-name)] (when key-accelerator (.setAccelerator menu-item (get-keystroke key-accelerator))) (when (and (not (is-mac)) key-mnemonic) (.setMnemonic menu-item (.getKeyCode (get-keystroke key-mnemonic)))) (.addActionListener menu-item (reify ActionListener (actionPerformed [this action-event] (response-fn)))) (.add menu menu-item))) ([menu item] (condp = item :sep (.addSeparator menu)))) (defn add-menu "Each item-tuple is a vector containing a menu item's text, mnemonic key, accelerator key, and the function it executes." [menu-bar title key-mnemonic & item-tuples] (let [menu (JMenu. title)] (when (and (not (is-mac)) key-mnemonic) (.setMnemonic menu (.getKeyCode (get-keystroke key-mnemonic)))) (run! #(apply add-menu-item menu %) item-tuples) (.add menu-bar menu) menu)) ;; mouse (defn on-click [comp num-clicks fun] (.addMouseListener comp (proxy [MouseAdapter] [] (mouseClicked [event] (when (== num-clicks (.getClickCount event)) (.consume event) (fun)))))) ;; undoability (defn make-undoable [text-area] (let [undoMgr (UndoManager.)] (.setLimit undoMgr 1000) (.. text-area getDocument (addUndoableEditListener (reify UndoableEditListener (undoableEditHappened [this evt] (.addEdit undoMgr (.getEdit evt)))))) (attach-action-keys text-area ["cmd1 Z" #(when (.canUndo undoMgr) (.undo undoMgr))] ["cmd1 shift Z" #(when (.canRedo undoMgr) (.redo undoMgr))]))) ;; file handling (defn choose-file [parent title suffix load] (let [dialog (doto (FileDialog. parent title (if load FileDialog/LOAD FileDialog/SAVE)) (.setFilenameFilter (reify FilenameFilter (accept [this _ name] (. name endsWith suffix)))) (.setVisible true)) d (.getDirectory dialog) n (.getFile dialog)] (when (and d n) (File. d n)))) ;doesn't work with Java 7 -- see version below ;(defn choose-directory [parent title] ; (if (is-mac) ; (let [dirs-on #(System/setProperty ; "apple.awt.fileDialogForDirectories" (str %))] ; (dirs-on true) ; (let [f (choose-file parent title "" true)] ; (dirs-on false) ; (.getParentFile f))) ; (let [fc (JFileChooser.) ; last-open-dir (read-value-from-prefs clooj-prefs "last-open-dir")] ; (doto fc (.setFileSelectionMode JFileChooser/DIRECTORIES_ONLY) ; (.setDialogTitle title) ; (.setCurrentDirectory (if last-open-dir (File. last-open-dir) nil))) ; (if (= JFileChooser/APPROVE_OPTION (.showOpenDialog fc parent)) ; (.getSelectedFile fc))))) (defn choose-directory [parent title] (let [fc (JFileChooser.) last-open-dir (read-value-from-prefs clooj-prefs "last-open-dir")] (doto fc (.setFileSelectionMode JFileChooser/DIRECTORIES_ONLY) (.setDialogTitle title) (.setCurrentDirectory (if last-open-dir (File. last-open-dir) nil))) (when (= JFileChooser/APPROVE_OPTION (.showOpenDialog fc parent)) (.getSelectedFile fc)))) (defn get-directories [path] (filter #(and (.isDirectory %) (not (.startsWith (.getName %) "."))) (.listFiles path))) (defn file-exists? [file] (and file (.. file exists))) ;; tree seq on widgets (awt or swing) (defn widget-seq [^java.awt.Component comp] (tree-seq #(instance? java.awt.Container %) #(seq (.getComponents %)) comp)) ;; saving and restoring window shape in preferences (defn get-shape [components] (for [comp components] (condp instance? comp Window [:window {:x (.getX comp) :y (.getY comp) :w (.getWidth comp) :h (.getHeight comp)}] JSplitPane [:split-pane {:location (.getDividerLocation comp)}] nil))) (defn watch-shape [components fun] (doseq [comp components] (condp instance? comp Window (.addComponentListener comp (proxy [java.awt.event.ComponentAdapter] [] (componentMoved [_] (fun)) (componentResized [_] (fun)))) JSplitPane (.addPropertyChangeListener comp JSplitPane/DIVIDER_LOCATION_PROPERTY (proxy [java.beans.PropertyChangeListener] [] (propertyChange [_] (fun)))) nil))) (defn set-shape [components shape-data] (loop [comps components shapes shape-data] (let [comp (first comps) shape (first shapes)] (try (when shape (condp = (first shape) :window (let [{:keys [x y w h]} (second shape)] (.setBounds comp x y w h)) :split-pane (.setDividerLocation comp (:location (second shape))) nil)) (catch Exception e nil))) (when (next comps) (recur (next comps) (next shapes))))) (defn save-shape [prefs name components] (write-value-to-prefs prefs name (get-shape components))) (defn restore-shape [prefs name components] (try (set-shape components (read-value-from-prefs prefs name)) (catch Exception e))) (defn confirmed? [question title] (= JOptionPane/YES_OPTION (JOptionPane/showConfirmDialog nil question title JOptionPane/YES_NO_OPTION))) (defn ask-value [question title] (JOptionPane/showInputDialog nil question title JOptionPane/QUESTION_MESSAGE)) (defn persist-window-shape [prefs name ^java.awt.Window window] (let [components (widget-seq window) shape-persister (agent nil)] (restore-shape prefs name components) (watch-shape components #(send-off shape-persister (fn [old-shape] (let [shape (get-shape components)] (when (not= old-shape shape) (write-value-to-prefs prefs name shape)) shape)))))) (defn sha1-str [obj] (let [bytes (.getBytes (with-out-str (pr obj)))] (String. (.digest (MessageDigest/getInstance "MD") bytes)))) ;; streams, writers and readers (defn printstream-to-writer [writer] (-> (proxy [OutputStream] [] (write ([^bytes bs offset length] (.write writer (.toCharArray (String. ^bytes bs "utf-8")) offset length)) ([b] (.write writer b))) (flush [] (.flush writer)) (close [] (.close writer))) (PrintStream. true))) (defn process-reader "Create a buffered reader from the output of a process." [process] (-> process .getInputStream InputStreamReader. BufferedReader.)) (defn copy-input-stream-to-writer "Continuously copies all content from a java InputStream to a java Writer. Blocks until InputStream closes." [input-stream writer] (let [reader (InputStreamReader. input-stream)] (loop [] (let [c (.read reader)] (when (not= c -1) (.write writer c) (recur)))))) ;; .clj file in current jar (defn local-clj-source "Reads a clj source file inside a jar from the current classpath." [clj-file] (try (-> (Thread/currentThread) .getContextClassLoader (.getResource clj-file) .toString java.net.URL. slurp) (catch Exception _ nil)))