├── .dir-locals.el ├── .github └── workflows │ └── test.yml ├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── elm-defuns.el ├── elm-font-lock.el ├── elm-format.el ├── elm-imenu.el ├── elm-indent-simple.el ├── elm-indent.el ├── elm-interactive.el ├── elm-mode.el ├── elm-tags.el ├── elm-util.el └── elm.tags /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ;;; Directory Local Variables 2 | ;;; For more information see (info "(emacs) Directory Variables") 3 | 4 | ((elm-mode 5 | (package-lint-main-file . "elm-mode.el"))) 6 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | pull_request: 5 | push: 6 | paths-ignore: 7 | - '**.md' 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | strategy: 13 | matrix: 14 | emacs_version: 15 | - 25.1 16 | - 25.3 17 | - 26.1 18 | - 26.3 19 | - 27.1 20 | - 27.2 21 | - 28.1 22 | - 28.2 23 | - snapshot 24 | steps: 25 | - uses: purcell/setup-emacs@master 26 | with: 27 | version: ${{ matrix.emacs_version }} 28 | 29 | - uses: actions/checkout@v3 30 | - name: Run tests 31 | run: make 32 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | build/ 2 | cache/ 3 | *.*~ 4 | [#]* 5 | *.elc 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | {one line to give the program's name and a brief idea of what it does.} 635 | Copyright (C) {year} {name of author} 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | {project} Copyright (C) {year} {fullname} 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS ?= emacs 2 | 3 | # A space-separated list of required package names 4 | NEEDED_PACKAGES = f s reformatter package-lint 5 | 6 | INIT_PACKAGES="(progn \ 7 | (require 'package) \ 8 | (push '(\"melpa\" . \"https://melpa.org/packages/\") package-archives) \ 9 | (package-initialize) \ 10 | (dolist (pkg '(${NEEDED_PACKAGES})) \ 11 | (unless (package-installed-p pkg) \ 12 | (unless (assoc pkg package-archive-contents) \ 13 | (package-refresh-contents)) \ 14 | (package-install pkg))) \ 15 | )" 16 | 17 | all: compile package-lint clean-elc 18 | 19 | package-lint: 20 | ${EMACS} -Q --eval ${INIT_PACKAGES} --eval '(setq package-lint-main-file "elm-mode.el")' -batch -f package-lint-batch-and-exit *.el 21 | 22 | compile: clean-elc 23 | ${EMACS} -Q --eval ${INIT_PACKAGES} -L . -batch -f batch-byte-compile *.el 24 | 25 | clean-elc: 26 | rm -f f.elc 27 | 28 | .PHONY: all compile clean-elc package-lint 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Melpa Status](http://melpa.org/packages/elm-mode-badge.svg)](http://melpa.org/#/elm-mode) 2 | [![Melpa Stable Status](http://stable.melpa.org/packages/elm-mode-badge.svg)](http://stable.melpa.org/#/elm-mode) 3 | [![Build Status](https://github.com/jcollard/elm-mode/workflows/CI/badge.svg)](https://github.com/jcollard/elm-mode/actions) 4 | 5 | # elm-mode 6 | 7 | Elm mode for Emacs. 8 | 9 | ## Features 10 | 11 | 1. Syntax highlighting. 12 | 1. Intelligent indentation. 13 | 1. Integration with `elm-make` 14 | 1. Integration with `elm-repl` 15 | 1. Integration with `elm-reactor` 16 | 1. Integration with `elm-package` 17 | 1. Integration with [elm-format][elm-format] 18 | 1. Integration with [elm-test][elm-test] 19 | 20 | ## Indentation 21 | 22 | `elm-mode` indentation is based on cycling: every time you insert a new 23 | line there will be one or more indentation levels available for you to 24 | choose from. The exact number is printed in the minibuffer either as 25 | `Sole indentation` or `Indent cycle (n)...` where `n` is the number of 26 | available indentations to choose from. If the automatic indentation 27 | level was not the one you expected simply hit `TAB` to cycle through the 28 | list (note that hitting any other key will cancel the cycle). 29 | 30 | ### Simpler indentation 31 | There is also a simpler indentation mode, `Elm Indent Simple` which doesn't try 32 | to be as smart as the default one. The benefit of this mode is that it works a 33 | little more similarly to how more conventional editors handle indentation: 34 | indent one step forward by pressing `TAB`, one step backward with `S-TAB`. 35 | 36 | It tries to be a little smart, however, and guess the easiest to determine 37 | indentation levels. 38 | 39 | You can enable it by setting a variable, `elm-mode-indent-mode` to 40 | `#'elm-indent-simple-mode`, for example by doing this: 41 | 42 | ```elisp 43 | (setq elm-mode-hook '(elm-indent-simple-mode)) 44 | ``` 45 | 46 | ## Installation 47 | 48 | This package requires *Emacs 25.1 or later*. 49 | 50 | ### MELPA 51 | 52 | You can install `elm-mode` from the package in 53 | [MELPA](https://melpa.org/). This is by far the most straightforward 54 | and recommended installation method. 55 | 56 | ### From source 57 | 58 | Add this repo to your load-path and `(require 'elm-mode)`. Ensure that 59 | you have installed all the dependencies listed in the `Package-Requires` 60 | header of `elm-mode.el`. 61 | 62 | ## Bindings 63 | 64 | The following bindings are available in `elm-mode`: 65 | 66 | #### `TAGS` 67 | 68 | | Keybinding | Description | 69 | | ---------------------- | ------------------------------------------------------------------- | 70 | | C-c M-t | Generate a TAGS file for the current project. | 71 | | M-. | Jump to tag at point. | 72 | | M-, | Jump to previous location after visiting a tag. | 73 | 74 | TAGS file generation requires that the UNIX `find`, `egrep` commands 75 | and the Emacs `etags` command be available in your path. 76 | 77 | Set or customize `elm-tags-on-save` to `t` to generate a new TAGS file 78 | for the current project on every save. 79 | 80 | Set or customize `elm-tags-exclude-elm-stuff` to `nil` to include 81 | source files inside `elm-stuff` directories when generating the TAGS 82 | file. 83 | 84 | #### `elm-make` 85 | 86 | | Keybinding | Description | 87 | | ---------------------- | --------------------------------------------------------------------------------- | 88 | | C-c C-c | Compile the current buffer. | 89 | | C-u C-c C-c | Compile the current buffer, specifying the output file. | 90 | | C-c M-c | Compile the main elm file. | 91 | | C-u C-c M-c | Compile the main elm file, specifying the output file. | 92 | | C-c C-a | Add missing type annotations to the current buffer. | 93 | | C-u C-c C-a | Add missing type annotations to the current buffer, prompting before each change. | 94 | | C-c C-r | Clean up imports in the current buffer. | 95 | | C-u C-c C-r | Clean up imports in the current buffer, prompting before each change. | 96 | 97 | 98 | #### `elm-repl` 99 | 100 | | Keybinding | Description | 101 | | ------------------ | ---------------------------------------------------------------------- | 102 | | C-c C-l | Load the current file in a REPL. | 103 | | C-c C-p | Push the current region to a REPL. | 104 | | C-c C-e | Push the current decl. to a REPL (requires haskell-mode). | 105 | 106 | #### `elm-reactor` 107 | 108 | | Keybinding | Description | 109 | | ---------------------- | ------------------------------------------------------------------ | 110 | | C-c C-n | Preview the current buffer in a browser. | 111 | | C-u C-c C-n | Preview the current buffer in a browser in debug mode. | 112 | | C-c C-m | Preview the main elm file in a browser. | 113 | | C-u C-c C-m | Preview the main elm file in a browser in debug mode. | 114 | 115 | #### `elm-package` 116 | 117 | | Keybinding | Description | 118 | | ---------------------- | ------------------------------------------------------------ | 119 | | C-c C-d | View a function's documentation in a browser. | 120 | | C-c C-i | Import a module from one of the dependencies. | 121 | | C-c C-s | Sort the imports in the current file. | 122 | | C-c M-k | Open the package catalog. | 123 | | C-u C-c M-k | Open the package catalog, refreshing the package list first. | 124 | 125 | The following bindings are available in the package list buffer: 126 | 127 | | Keybinding | Description | 128 | | ------------ | ------------------------------ | 129 | | g | Refresh package list. | 130 | | n | Next package. | 131 | | p | Previous package. | 132 | | v | View package in browser. | 133 | | m | Mark package for installation. | 134 | | i | Mark package for installation. | 135 | | u | Unmark package. | 136 | | x | Install marked packages. | 137 | 138 | Set or customize `elm-sort-imports-on-save` to `t` to apply 139 | `elm-sort-imports` on the current buffer on every save. 140 | 141 | #### Completion for Elm >= 0.19 142 | 143 | To obtain completion, code navigation and other niceties, use 144 | [elm-language-server](https://github.com/elm-tooling/elm-language-server) 145 | and an LSP package. [eglot](https://github.com/joaotavora/eglot) is a lightweight 146 | LSP front-end package for Emacs, and has built-in support for `elm-language-server`. 147 | Some users might prefer the rather larger and more opinionated [lsp-mode](https://github.com/emacs-lsp/lsp-mode). 148 | 149 | #### `elm-format` 150 | 151 | The following functionality requires [elm-format][elm-format] to be 152 | installed. `elm-format` does not come with the Elm installer so you 153 | will have to install it manually. 154 | 155 | | Keybinding | Description | 156 | | ------------------ | ---------------------------------------- | 157 | | C-c C-f | Automatically format the current buffer. | 158 | 159 | Enable `elm-format-on-save-mode` to apply `elm-format` on the current 160 | buffer on every save. You might like to add it to your 161 | `elm-mode-hook`: 162 | 163 | ```elisp 164 | (add-hook 'elm-mode-hook 'elm-format-on-save-mode) 165 | ``` 166 | 167 | Alternatively, you can enable it on a per-project basis by including an 168 | entry like the following in your `.dir-locals.el`: 169 | 170 | ```elisp 171 | (elm-mode (mode . elm-format-on-save)) 172 | ``` 173 | 174 | #### `elm-test` 175 | 176 | The following functionality requires [elm-test][elm-test] to be 177 | installed. `elm-test` does not come with the Elm installer so you 178 | will have to install it manually. 179 | 180 | | Keybinding | Description | 181 | | ------------------ | ------------------------------------------- | 182 | | C-c C-v | Run the test suite for the current project. | 183 | 184 | 185 | [company-mode]: http://company-mode.github.io/ 186 | [elm-format]: https://github.com/avh4/elm-format#installation- 187 | [elm-test]: https://github.com/rtfeldman/node-test-runner 188 | -------------------------------------------------------------------------------- /elm-defuns.el: -------------------------------------------------------------------------------- 1 | ;;; elm-defuns.el --- Find start/end of elm defuns -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2013, 2014 Joseph Collard 4 | ;; Copyright (C) 2015, 2016 Bogdan Popa 5 | ;; Copyright (C) 2023 Steve Purcell 6 | 7 | ;; Author: Steve Purcell 8 | 9 | ;; This file is not part of GNU Emacs. 10 | 11 | ;; This file is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation; either version 3, or (at your option) 14 | ;; any later version. 15 | 16 | ;; This file is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;;; Code: 27 | 28 | (defun elm-beginning-of-defun (&optional arg) 29 | "Move backward to the beginning of an ELM \"defun\". 30 | With ARG, do it that many times. Negative arg -N means move 31 | forward to Nth following beginning of defun. Returns t unless 32 | search stops due to beginning or end of buffer. 33 | 34 | Find the roots of this function in the c-awk-mode." 35 | (interactive "p") 36 | (or arg (setq arg 1)) 37 | (save-match-data 38 | (let ((found t) ; Has the most recent regexp search found b-of-defun? 39 | (regexp "^[^- \t\n\r]")) 40 | (if (>= arg 0) 41 | ;; Go back one defun each time round the following loop. (For +ve arg) 42 | (while (and found (< 0 arg) (not (eq (point) (point-min)))) 43 | ;; Go back one "candidate" each time round the next loop until one 44 | ;; is genuinely a beginning-of-defun. 45 | 46 | (setq found (search-backward-regexp 47 | regexp (point-min) 'stop-at-limit)) 48 | (when found 49 | (while (and (forward-line -1) 50 | (looking-at regexp) 51 | (not (= (point-min) (point))))) 52 | (forward-line)) 53 | (setq arg (1- arg))) 54 | ;; The same for a -ve arg. 55 | (if (not (eq (point) (point-max))) (forward-char 1)) 56 | (while (and found (< arg 0) (not (eq (point) (point-max)))) ; The same for -ve arg. 57 | (setq found (search-forward-regexp 58 | regexp (point-min) 'stop-at-limit)) 59 | (setq arg (1+ arg)))) 60 | (eq arg 0)))) 61 | 62 | (defun elm-end-of-defun (&optional arg) 63 | "Move forward to the end of an ELM \"defun\". 64 | With ARG, do it that many times. Negative arg -N means move 65 | forward to Nth previous end of defun. Returns t unless 66 | search stops due to beginning or end of buffer. 67 | 68 | Find the roots of this function in the c-awk-mode." 69 | (interactive "p") 70 | (or arg (setq arg 1)) 71 | (save-match-data 72 | (let ((found t) ; Has the most recent regexp search found b-of-defun? 73 | (regexp "^\n\n")) 74 | (if (>= arg 0) 75 | ;; Go back one defun each time round the following loop. (For +ve arg) 76 | (while (and found (< 0 arg) (not (eq (point) (point-max)))) 77 | ;; Go back one "candidate" each time round the next loop until one 78 | ;; is genuinely a beginning-of-defun. 79 | (setq found (search-forward-regexp 80 | regexp 81 | (point-max) 'stop-at-limit)) 82 | (setq arg (1- arg))) 83 | ;; The same for a -ve arg. 84 | (if (not (eq (point) (point-min))) (forward-char 1)) 85 | (while (and found (< arg 0) (not (eq (point) (point-min)))) ; The same for -ve arg. 86 | (setq found (search-backward-regexp 87 | regexp (point-min) 'stop-at-limit)) 88 | (setq arg (1+ arg))) 89 | (if found (goto-char (match-beginning 0)))) 90 | (eq arg 0)))) 91 | 92 | 93 | (provide 'elm-defuns) 94 | ;;; elm-defuns.el ends here 95 | -------------------------------------------------------------------------------- /elm-font-lock.el: -------------------------------------------------------------------------------- 1 | ;;; elm-font-lock.el --- Font locking module for Elm mode. -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2013, 2014 Joseph Collard 4 | ;; Copyright (C) 2015 Bogdan Popa 5 | 6 | ;; Authors: Joseph Collard 7 | ;; URL: https://github.com/jcollard/elm-mode 8 | 9 | ;; This file is not part of GNU Emacs. 10 | 11 | ;; This file is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation; either version 3, or (at your option) 14 | ;; any later version. 15 | 16 | ;; This file is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | ;;; Code: 26 | (require 'font-lock) 27 | (require 'rx) 28 | 29 | (defgroup elm-font-lock nil 30 | "Font locking for Elm code." 31 | :group 'faces) 32 | 33 | (defface elm-font-lock-operators 34 | '((t :inherit font-lock-builtin-face)) 35 | "The default face used to highlight operators inside expressions." 36 | :group 'elm-font-lock) 37 | 38 | (defcustom elm-font-lock-operators-face 'elm-font-lock-operators 39 | "The face used to highlight operators inside expressions. 40 | To disable this highlighting, set this to nil." 41 | :type '(choice (const nil) 42 | face) 43 | :group 'elm-font-lock) 44 | 45 | (defface elm-font-lock-multiline-list-delimiters 46 | '((t :inherit font-lock-keyword-face)) 47 | "The default face used to highlight brackets and commas in multiline lists." 48 | :group 'elm-font-lock) 49 | 50 | (defcustom elm-font-lock-multiline-list-delimiters-face 'elm-font-lock-multiline-list-delimiters 51 | "The face used to highlight brackets and commas in multilist lists. 52 | To disable this highlighting, set this to nil." 53 | :type '(choice (const nil) 54 | face) 55 | :group 'elm-font-lock) 56 | 57 | (defconst elm--keywords 58 | '("if" "then" "else" 59 | "case" "of" 60 | "let" "in" 61 | "type" "alias" 62 | "module" 63 | "where" 64 | "import" "as" "exposing" 65 | "port") 66 | "Reserved keywords.") 67 | 68 | (defconst elm--regexp-keywords 69 | (regexp-opt elm--keywords 'symbols) 70 | "A regular expression representing the reserved keywords.") 71 | 72 | (defconst elm--font-lock-keywords 73 | (cons elm--regexp-keywords font-lock-keyword-face) 74 | "Highlighting for keywords.") 75 | 76 | (defun elm--syntax-stringify () 77 | "Syntax propertize triple quoted strings." 78 | (let* ((ppss (save-excursion 79 | (backward-char 3) 80 | (syntax-ppss))) 81 | (string-started (and (not (nth 4 ppss)) (nth 8 ppss))) 82 | (quote-starting-pos (- (point) 3)) 83 | (quote-ending-pos (point))) 84 | (if (not string-started) 85 | (put-text-property quote-starting-pos (1+ quote-starting-pos) 86 | 'syntax-table (string-to-syntax "|")) 87 | (put-text-property (1- quote-ending-pos) quote-ending-pos 88 | 'syntax-table (string-to-syntax "|"))))) 89 | 90 | (defconst elm--syntax-propertize 91 | (syntax-propertize-rules 92 | ;;; Syntax rule for char literals 93 | ((rx (and (1+ " ") 94 | (group "'") 95 | (optional "\\") any 96 | (group "'"))) 97 | (1 "\"") 98 | (2 "\"")) 99 | 100 | ((rx (and (or point 101 | (not (any ?\\ ?\")) 102 | (and (or (not (any ?\\)) point) ?\\ (* ?\\ ?\\) (any ?\"))) 103 | (* ?\\ ?\\) 104 | "\"\"\"")) 105 | (0 (ignore (elm--syntax-stringify)))))) 106 | 107 | (defun elm--syntax-propertize-function (begin end) 108 | "Mark special lexemes between BEGIN and END." 109 | (funcall elm--syntax-propertize begin end) 110 | (save-excursion 111 | (goto-char begin) 112 | (while (re-search-forward "\\\\[({]" end t) 113 | (let ((open (match-beginning 0))) 114 | (add-text-properties open (1+ open) '(syntax-table (1 . nil))))))) 115 | 116 | (defvar elm--syntax-table 117 | (let ((st (make-syntax-table))) 118 | ;;; Syntax entry for {- -} type comments. 119 | (modify-syntax-entry ?\{ "(}1nb" st) 120 | (modify-syntax-entry ?\} "){4nb" st) 121 | (modify-syntax-entry ?- ". 123" st) 122 | (modify-syntax-entry ?\n ">" st) 123 | (modify-syntax-entry ?. "_" st) 124 | 125 | (modify-syntax-entry ?\" "\"\"" st) 126 | (modify-syntax-entry ?\\ "\\" st) 127 | st)) 128 | 129 | ;;; Name regexp is according to https://github.com/elm-lang/elm-compiler/blob/353930a474fee4d833f962100edde70417691bca/src/Parse/Helpers.hs#L65 130 | (defconst elm--regexp-function 131 | "^\\([a-z_][0-9A-Za-z_']*\\|([^)]+)\\)" 132 | "A regular expression representing function names.") 133 | 134 | (defconst elm--font-lock-functions 135 | (cons elm--regexp-function font-lock-function-name-face) 136 | "Highlighting for function names.") 137 | 138 | (defconst elm--regexp-type 139 | "\\<[A-Z][0-9A-Za-z_']*" 140 | "A regular expression representing modules and types.") 141 | 142 | (defconst elm--font-lock-types 143 | (cons elm--regexp-type font-lock-type-face) 144 | "Highlighting for module names and types.") 145 | 146 | (defconst elm--regexp-operators 147 | (concat "\\(" "`[^`]+`" 148 | "\\|" "\\B\\\\" 149 | "\\|" "[-+*/\\\\|<>=:!@#$%^&,.]+" 150 | "\\)") 151 | "A regular expression representing operators inside expressions.") 152 | 153 | (defconst elm--font-lock-operators 154 | (cons elm--regexp-operators '(1 elm-font-lock-operators-face)) 155 | "Highlighting for operators inside expressions.") 156 | 157 | (defconst elm--regexp-multiline-list-comma-closing-brackets 158 | (concat "^[[:space:]]*" (regexp-opt '("," "]" "}") t)) 159 | "Regexp for commas and closing brackets in multiline lists/records.") 160 | 161 | (defconst elm--font-lock-multiline-list-comma-closing-brackets 162 | (cons elm--regexp-multiline-list-comma-closing-brackets 163 | '(1 elm-font-lock-multiline-list-delimiters-face)) 164 | "Highlighting for commas and closing brackets in multiline lists and records.") 165 | 166 | (defun elm--match-multiline-list-opening-bracket (limit) 167 | "Search for opening brackets in multiline lists and records. 168 | Also highlights opening brackets without a matching bracket. 169 | LIMIT is the extent of the search." 170 | (when (elm--search-forward-opening-bracket limit) 171 | (let ((opening (point)) 172 | (eol (line-end-position)) 173 | (closing (elm--search-forward-closing-bracket))) 174 | (if (or (= closing opening) (> closing eol)) 175 | (progn 176 | (set-match-data (match-data)) 177 | (goto-char (+ 1 opening)) 178 | t) 179 | (elm--match-multiline-list-opening-bracket limit))))) 180 | 181 | (defun elm--search-forward-opening-bracket (limit) 182 | "Go to the next opening bracket up to LIMIT." 183 | (if (search-forward-regexp (regexp-opt '("[" "{")) limit t) 184 | (progn 185 | (backward-char) 186 | t))) 187 | 188 | (defun elm--search-forward-closing-bracket () 189 | "Go to the next matching bracket. 190 | Assumes that the cursor is on an opening bracket." 191 | (ignore-errors 192 | (save-match-data 193 | (forward-sexp))) 194 | (point)) 195 | 196 | (defconst elm--font-lock-multiline-list-opening-brackets 197 | '(elm--match-multiline-list-opening-bracket (0 elm-font-lock-multiline-list-delimiters-face)) 198 | "Highlighting for opening brackets in multiline lists and records.") 199 | 200 | (defconst elm--font-lock-highlighting 201 | (list (list elm--font-lock-keywords 202 | elm--font-lock-functions 203 | elm--font-lock-types 204 | elm--font-lock-multiline-list-comma-closing-brackets 205 | elm--font-lock-multiline-list-opening-brackets 206 | elm--font-lock-operators) 207 | nil nil)) 208 | 209 | (defun elm--font-lock-enable () 210 | "Turn on Elm font lock." 211 | (setq font-lock-multiline t) 212 | (set-syntax-table elm--syntax-table) 213 | (set (make-local-variable 'syntax-propertize-function) #'elm--syntax-propertize-function) 214 | (set (make-local-variable 'font-lock-defaults) elm--font-lock-highlighting)) 215 | 216 | (provide 'elm-font-lock) 217 | ;;; elm-font-lock.el ends here 218 | -------------------------------------------------------------------------------- /elm-format.el: -------------------------------------------------------------------------------- 1 | ;;; elm-format.el --- Automatically format an Elm buffer. 2 | 3 | ;; Copyright (C) 2015 Bogdan Popa 4 | 5 | ;; Author: Bogdan Popa 6 | ;; URL: https://github.com/jcollard/elm-mode 7 | 8 | ;; This file is not part of GNU Emacs. 9 | 10 | ;; This file is free software; you can redistribute it and/or modify 11 | ;; it under the terms of the GNU General Public License as published by 12 | ;; the Free Software Foundation; either version 3, or (at your option) 13 | ;; any later version. 14 | 15 | ;; This file is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with this program. If not, see . 22 | 23 | ;;; Commentary: 24 | ;;; Code: 25 | 26 | (require 'reformatter) 27 | 28 | (defcustom elm-format-on-save nil 29 | "When non-nil, run `elm-format-buffer' on save. 30 | 31 | This variable is obsolete, and you should prefer to enable 32 | `elm-format-on-save-mode' by adding it to your `elm-mode-hook', 33 | or by placing a clause like the following in the .dir-locals.el 34 | for your project: 35 | 36 | ((elm-mode (mode . elm-format-on-save)))" 37 | :group 'elm-format 38 | :type 'boolean) 39 | 40 | (defcustom elm-format-elm-version "0.19" 41 | "The version of Elm against which code should be formatted." 42 | :group 'elm-format 43 | :type 'string) 44 | 45 | (defcustom elm-format-command "elm-format" 46 | "The name of the `elm-format' command." 47 | :group 'elm-format 48 | :type 'string) 49 | 50 | ;;;###autoload (autoload 'elm-format-buffer "elm-format" nil t) 51 | ;;;###autoload (autoload 'elm-format-on-save-mode "elm-format" nil t) 52 | (reformatter-define elm-format 53 | :program elm-format-command 54 | :args (list "--stdin" "--elm-version" elm-format-elm-version "--yes") 55 | :group 'elm-format 56 | :lighter " ElmFmt") 57 | 58 | ;;;###autoload 59 | (define-obsolete-function-alias 'elm-mode-format-buffer 'elm-format-buffer "20190113") 60 | 61 | 62 | (provide 'elm-format) 63 | ;;; elm-format.el ends here 64 | -------------------------------------------------------------------------------- /elm-imenu.el: -------------------------------------------------------------------------------- 1 | ;;; elm-imenu.el --- imenu support for elm 2 | ;;; Commentary: 3 | ;;; Code: 4 | (require 'imenu) 5 | 6 | (defcustom elm-imenu-use-categories t 7 | "Group imenu entries by their type, e.g. functions, type aliases." 8 | :group 'elm 9 | :type 'boolean 10 | :safe 'booleanp) 11 | 12 | (defun elm-imenu-create-index () 13 | "Create an imenu index for the current buffer." 14 | (save-excursion 15 | (imenu--generic-function 16 | `((,(and elm-imenu-use-categories "Type") "^type\\s-+\\([A-Z]\\(?:\\s_\\|\\sw\\)*\\)" 1) 17 | (,(and elm-imenu-use-categories "Type Alias") "^type\\s-+alias\\s-+\\([A-Z]\\(?:\\s_\\|\\sw\\)*\\)" 1) 18 | (,(and elm-imenu-use-categories "Port") "^port\\s-+\\(\\(?:\\s_\\|\\sw\\)+\\)" 1) 19 | (,(and elm-imenu-use-categories "Function") "^\\(\\(?:\\s_\\|\\sw\\)+\\)\\s-+:" 1))))) 20 | 21 | (provide 'elm-imenu) 22 | ;;; elm-imenu.el ends here 23 | -------------------------------------------------------------------------------- /elm-indent-simple.el: -------------------------------------------------------------------------------- 1 | ;;; elm-indent-simple.el --- "stupid" indentation module for Elm Mode -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright 2021 Theodor Thornhill 4 | 5 | ;; This file is not part of GNU Emacs. 6 | 7 | ;; This file is free software; you can redistribute it and/or modify 8 | ;; it under the terms of the GNU General Public License as published by 9 | ;; the Free Software Foundation; either version 3, or (at your option) 10 | ;; any later version. 11 | 12 | ;; This file is distributed in the hope that it will be useful, 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;; GNU General Public License for more details. 16 | 17 | ;; You should have received a copy of the GNU General Public License 18 | ;; along with this program. If not, see . 19 | 20 | (require 'cl-lib) 21 | 22 | ;;; Indentation 23 | 24 | (defcustom elm-indent-simple-offset 4 25 | "Indent Elm code by this number of spaces." 26 | :type 'integer 27 | :group 'elm 28 | :safe #'integerp) 29 | 30 | (defun elm-indent-simple--find-indentation-of-list () 31 | (save-excursion 32 | (backward-up-list 1) 33 | (+ (- (current-column) (current-indentation)) 34 | (current-indentation)))) 35 | 36 | (defun elm-indent-simple--find-indentation-of-tokens (tokens) 37 | (save-excursion 38 | (re-search-backward (regexp-opt tokens) (point-min) t nil) 39 | (+ (- (current-column) (current-indentation)) 40 | (current-indentation)))) 41 | 42 | (defun elm-indent-simple--two-lines-same-token-p (token) 43 | "Checks if line and previous line start with same token." 44 | (and (looking-at token) 45 | (save-excursion 46 | (forward-line -1) 47 | (back-to-indentation) 48 | (looking-at token)))) 49 | 50 | (defun elm-indent-simple--previous-line-ends-with (tokens) 51 | (save-excursion 52 | (forward-line -1) 53 | (end-of-line) 54 | (forward-comment (- (point))) 55 | (looking-back (regexp-opt tokens) nil))) 56 | 57 | (defun elm-indent-simple--previous-line-starts-with (tokens) 58 | (save-excursion 59 | (forward-line -1) 60 | (back-to-indentation) 61 | (looking-at-p (regexp-opt tokens)))) 62 | 63 | (defun elm-indent-simple-compute-indentation () 64 | "Return a column to indent to. 65 | 66 | The numbers we get are the positions we can determine from the 67 | given context. When we cannot find a context to indent to, we 68 | default to the indentation level of previous line." 69 | (let* ((indent-level-previous-line 70 | (save-excursion 71 | (forward-line -1) 72 | (current-indentation))) 73 | (positive-offset (+ indent-level-previous-line elm-indent-simple-offset))) 74 | (save-excursion 75 | (back-to-indentation) 76 | ;; Now we are positioned at start of indentation. 77 | ;; Logic below assumes this is true. 78 | (cond 79 | ((elm-indent-simple--previous-line-ends-with '("=" "<-" "[" "{" "of" "if" "else" ":" "->" "exposing")) positive-offset) 80 | ((looking-at-p (regexp-opt '("{-" "-}"))) 0) 81 | ((and (= indent-level-previous-line 0) (looking-at-p "=")) positive-offset) 82 | ((elm-indent-simple--previous-line-starts-with '("type" "let")) positive-offset) 83 | ((looking-at-p ")") (elm-indent-simple--find-indentation-of-list)) 84 | ((looking-at-p "}") (elm-indent-simple--find-indentation-of-list)) 85 | ((looking-at-p "]") (elm-indent-simple--find-indentation-of-list)) 86 | ((looking-at-p ",") (elm-indent-simple--find-indentation-of-list)) 87 | ((looking-at-p "else") (elm-indent-simple--find-indentation-of-tokens '("if"))) 88 | ((looking-at-p "then") (elm-indent-simple--find-indentation-of-tokens '("if"))) 89 | (t (elm-indent-simple-lastly)))))) 90 | 91 | (defun elm-indent-simple-level-2-previous-lines () 92 | "Returns indent level of the two previous lines." 93 | (save-excursion 94 | ;; Since we save-excursion above, we can go back two lines one by one, and 95 | ;; return the lines separately. 96 | (cl-values 97 | (progn 98 | (forward-line -1) 99 | (current-indentation)) 100 | (progn 101 | (forward-line -1) 102 | (current-indentation))))) 103 | 104 | (defun elm-indent-simple-lastly () 105 | (interactive) 106 | (cl-multiple-value-bind (previous-line 2nd-previous-line) 107 | (elm-indent-simple-level-2-previous-lines) 108 | (cond 109 | ((and (zerop previous-line) (zerop 2nd-previous-line)) 0) 110 | ((zerop previous-line) 2nd-previous-line) 111 | (t 112 | previous-line)))) 113 | 114 | (defun elm-indent-simple-do-indent (indent) 115 | (if (<= (current-column) (current-indentation)) 116 | (ignore-errors (indent-line-to indent)) 117 | (save-excursion (ignore-errors (indent-line-to indent))))) 118 | 119 | (defun elm-indent-simple-indent-line () 120 | "Set indent levels for Elm source code. 121 | 122 | Try to indent to the correct level. If indent level is 123 | ambiguous, multiple invocations will indent tabstops forward." 124 | (interactive) 125 | (elm-indent-simple-do-indent 126 | (elm-indent-simple-compute-indentation))) 127 | 128 | (defun elm-indent-simple-indent-region (start end) 129 | "Apply `elm-indent-simple-indent-line' to every line between START and END." 130 | (save-excursion 131 | (goto-char start) 132 | (while (< (point) end) 133 | (elm-indent-simple-indent-line) 134 | (forward-line)))) 135 | 136 | (defun elm-indent-simple-indent-forward (&optional arg) 137 | "Indent line to the next tabstop." 138 | (interactive "p") 139 | (elm-indent-simple-do-indent 140 | (indent-next-tab-stop (* (or arg 1) (current-indentation))))) 141 | 142 | (defun elm-indent-simple-indent-backward (&optional _arg) 143 | "Indent backwards to the nearest tabstop." 144 | (interactive "p") 145 | (elm-indent-simple-do-indent 146 | (indent-next-tab-stop 147 | (save-excursion (back-to-indentation) (current-column)) t))) 148 | 149 | 150 | (defvar elm-indent-simple-mode-map 151 | (let ((map (make-sparse-keymap))) 152 | (define-key map (kbd "C-c TAB") 'elm-indent-simple-indent-line) 153 | (define-key map (kbd "") 'elm-indent-simple-indent-forward) 154 | (define-key map (kbd "") 'elm-indent-simple-indent-backward) 155 | map)) 156 | 157 | ;;;###autoload 158 | (define-minor-mode elm-indent-simple-mode 159 | "\"Stupid\" Elm indentation mode." 160 | :global nil 161 | :lighter " EIndent-simple" 162 | :map 'elm-indent-simple-mode-map 163 | 164 | (if elm-indent-simple-mode 165 | (progn 166 | (setq-local tab-width elm-indent-simple-offset) 167 | (setq-local indent-line-function #'elm-indent-simple-indent-line) 168 | (setq-local indent-region-function nil)) 169 | (kill-local-variable 'tab-width) 170 | (kill-local-variable 'indent-line-function))) 171 | 172 | (provide 'elm-indent-simple) 173 | ;;; elm-indent-simple.el ends here 174 | -------------------------------------------------------------------------------- /elm-indent.el: -------------------------------------------------------------------------------- 1 | ;;; elm-indent.el --- "semi-intelligent" indentation module for Elm Mode 2 | 3 | ;; Copyright 2004, 2005, 2007, 2008, 2009 Free Software Foundation, Inc. 4 | ;; Copyright 1997-1998 Guy Lapalme 5 | ;; Copyright 2015 Bogdan Popa 6 | 7 | ;; Author: 1997-1998 Guy Lapalme 8 | 9 | ;; This file is not part of GNU Emacs. 10 | 11 | ;; This file was adapted from `haskell-indent.el'. 12 | 13 | ;; This file is free software; you can redistribute it and/or modify 14 | ;; it under the terms of the GNU General Public License as published by 15 | ;; the Free Software Foundation; either version 3, or (at your option) 16 | ;; any later version. 17 | 18 | ;; This file is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | 23 | ;; You should have received a copy of the GNU General Public License 24 | ;; along with this program. If not, see . 25 | 26 | ;;; Commentary: 27 | ;;; Code: 28 | (require 's) 29 | (require 'cl-lib) 30 | 31 | 32 | ;;; Customizations 33 | (defgroup elm-indent nil 34 | "Elm indentation." 35 | :group 'elm 36 | :link '(custom-manual "(elm-mode)Indentation") 37 | :prefix "elm-indent-") 38 | 39 | (defcustom elm-indent-offset 4 40 | "Indentation of Elm statements with respect to containing block." 41 | :type 'integer 42 | :group 'elm-indent) 43 | 44 | (defcustom elm-indent-rhs-align-column 0 45 | "Column on which to align right-hand sides (use 0 for ad-hoc alignment)." 46 | :type 'integer 47 | :group 'elm-indent) 48 | 49 | (defcustom elm-indent-look-past-empty-line t 50 | "If nil, indentation engine will not look past an empty line for layout points." 51 | :group 'elm-indent 52 | :type 'boolean) 53 | 54 | (defcustom elm-indent-thenelse 0 55 | "If non-zero, \"then\" and \"else\" are indented by that amount." 56 | :group 'elm-indent 57 | :type 'integer) 58 | 59 | (defcustom elm-indent-after-keywords 60 | `(("of" ,elm-indent-offset) 61 | ("in" ,elm-indent-offset 0) 62 | ("{" ,elm-indent-offset) 63 | "if" 64 | "then" 65 | "else" 66 | "let") 67 | "Keywords after which indentation should be indented by some offset. 68 | Each keyword info can have the following forms: 69 | 70 | KEYWORD | (KEYWORD OFFSET [OFFSET-HANGING]) 71 | 72 | If absent OFFSET-HANGING defaults to OFFSET. 73 | If absent OFFSET defaults to `elm-indent-offset'. 74 | 75 | OFFSET-HANGING is the offset to use in the case where the keyword 76 | is at the end of an otherwise-non-empty line." 77 | :set-after '(elm-indent-offset) 78 | :group 'elm-indent 79 | :type '(repeat (choice string 80 | (cons :tag "" (string :tag "keyword:") 81 | (cons :tag "" (integer :tag "offset") 82 | (choice (const nil) 83 | (list :tag "" 84 | (integer :tag "offset-pending")))))))) 85 | 86 | (defcustom elm-indent-dont-hang '("(") 87 | "Lexemes that should never be considered as hanging." 88 | :group 'elm-indent 89 | :type '(repeat string)) 90 | 91 | 92 | ;;; Internals 93 | (defconst elm-indent-start-keywords-re 94 | (concat "\\<" 95 | (regexp-opt '("module" "import" "type" "infix" "infixl" "infixr") t) 96 | "\\>") 97 | "Regexp for keywords to complete when standing at the first word of a line.") 98 | 99 | (defvar elm-indent-off-side-keywords-re 100 | (concat "\\<" 101 | (regexp-opt '("let")) 102 | "\\>[ \t]*")) 103 | 104 | (defvar elm-indent-last-info nil) 105 | (defvar elm-indent-info) 106 | 107 | (defvar elm-indent-current-line-first-ident "" 108 | "Global variable that keeps track of the first ident of the line to indent.") 109 | 110 | (defvar elm-indent-inhibit-after-offset nil) 111 | 112 | (defun elm-indent-point-to-col (apoint) 113 | "Return the column number of APOINT." 114 | (save-excursion 115 | (goto-char apoint) 116 | (current-column))) 117 | 118 | (defun elm-indent-push-col (col &optional name) 119 | "Push indentation information for the column COL. 120 | The info is followed by NAME (if present). 121 | Makes sure that the same indentation info is not pushed twice. 122 | Uses free var `elm-indent-info'." 123 | (let ((tmp (cons col name))) 124 | (if (member tmp elm-indent-info) 125 | elm-indent-info 126 | (push tmp elm-indent-info)))) 127 | 128 | (defun elm-indent-push-pos (pos &optional name) 129 | "Push indentation information for POS followed by NAME (if present)." 130 | (elm-indent-push-col (elm-indent-point-to-col pos) name)) 131 | 132 | (defun elm-indent-column+offset (column offset) 133 | (unless offset (setq offset elm-indent-offset)) 134 | (setq column (+ column offset))) 135 | 136 | (defun elm-indent-push-pos-offset (pos &optional offset) 137 | "Pushes indentation information for the column corresponding to POS 138 | followed by an OFFSET (if present use its value otherwise use 139 | `elm-indent-offset')." 140 | (elm-indent-push-col (elm-indent-column+offset 141 | (elm-indent-point-to-col pos) 142 | offset))) 143 | 144 | (defun elm-indent-empty-line-p () 145 | "Checks if the current line is empty; deals with Bird style scripts." 146 | (save-excursion 147 | (beginning-of-line) 148 | (looking-at "[ \t]*$"))) 149 | 150 | (defun elm-indent-skip-blanks-and-newlines-forward (end) 151 | "Skip forward blanks, tabs and newlines until END." 152 | (skip-chars-forward " \t\n" end)) 153 | 154 | (defun elm-indent-skip-blanks-and-newlines-backward (start) 155 | "Skip backward blanks, tabs and newlines up to START." 156 | (skip-chars-backward " \t\n" start)) 157 | 158 | (defun elm-indent-start-of-def () 159 | "Return the position of the start of a definition. 160 | The start of a def is expected to be recognizable by starting in column 0, 161 | unless `elm-indent-look-past-empty-line' is nil, in which case we 162 | take a coarser approximation and stop at the first empty line." 163 | (save-excursion 164 | (let ((start-code nil) 165 | (top-col 0) 166 | (save-point (point))) 167 | ;; determine the starting point of the current piece of code 168 | (setq start-code (if start-code (1+ start-code) (point-min))) 169 | ;; go backward until the first preceding empty line 170 | (forward-line -1) 171 | (while (and (if elm-indent-look-past-empty-line 172 | (or (> (current-indentation) top-col) 173 | (elm-indent-empty-line-p)) 174 | (and (> (current-indentation) top-col) 175 | (not (elm-indent-empty-line-p)))) 176 | (> (point) start-code) 177 | (= 0 (forward-line -1)))) 178 | ;; go forward after the empty line 179 | (if (elm-indent-empty-line-p) 180 | (forward-line 1)) 181 | (setq start-code (point)) 182 | ;; find the first line of code which is not a comment 183 | (forward-comment (point-max)) 184 | (if (> (point) save-point) 185 | start-code 186 | (point))))) 187 | 188 | (defun elm-indent-open-structure (start end) 189 | "If any structure (list or tuple) is not closed, between START and END, 190 | returns the location of the opening symbol, nil otherwise." 191 | (save-excursion 192 | (nth 1 (parse-partial-sexp start end)))) 193 | 194 | (defun elm-indent-in-string (start end) 195 | "If a string is not closed , between START and END, returns the 196 | location of the opening symbol, nil otherwise." 197 | (save-excursion 198 | (let ((pps (parse-partial-sexp start end))) 199 | (if (nth 3 pps) (nth 8 pps))))) 200 | 201 | (defun elm-indent-in-comment (start end) 202 | "Check, starting from START, if END is at or within a comment. 203 | Returns the location of the start of the comment, nil otherwise." 204 | (when (<= start end) 205 | (let (pps) 206 | (cond ((= start end) nil) 207 | ((nth 4 (save-excursion (setq pps (parse-partial-sexp start end)))) 208 | (nth 8 pps)) 209 | ;; We also want to say that we are *at* the beginning of a comment. 210 | ((and (not (nth 8 pps)) 211 | (>= (point-max) (+ end 2)) 212 | (nth 4 (save-excursion 213 | (setq pps (parse-partial-sexp end (+ end 2)))))) 214 | (nth 8 pps)))))) 215 | 216 | (defun elm-indent-type-at-point () 217 | "Return the type of the line (also puts information in `match-data')." 218 | (cond 219 | ((elm-indent-empty-line-p) 'empty) 220 | ((elm-indent-in-comment (point-min) (point)) 'comment) 221 | ((looking-at "\\(\\([[:alpha:]]\\(\\sw\\|'\\)*\\)\\|_\\)[ \t\n]*") 'ident) 222 | ((looking-at "\\(|[^|]\\)[ \t\n]*") 'guard) 223 | ((looking-at "\\(=[^>=]\\|:[^:]\\|->\\|<-\\)[ \t\n]*") 'rhs) 224 | (t 'other))) 225 | 226 | (defun elm-indent-contour-line (start end) 227 | "Generate contour information between START and END points." 228 | (if (< start end) 229 | (save-excursion 230 | (goto-char end) 231 | (elm-indent-skip-blanks-and-newlines-backward start) 232 | (let ((cur-col (current-column)) ; maximum column number 233 | (fl 0) ; number of lines that forward-line could not advance 234 | contour) 235 | (while (and (> cur-col 0) (= fl 0) (>= (point) start)) 236 | (back-to-indentation) 237 | (if (< (point) start) (goto-char start)) 238 | (and (not (member (elm-indent-type-at-point) 239 | '(empty comment))) ; skip empty and comment lines 240 | (< (current-column) cur-col) ; less indented column found 241 | (push (point) contour) ; new contour point found 242 | (setq cur-col (current-column))) 243 | (setq fl (forward-line -1))) 244 | contour)))) 245 | 246 | (defun elm-indent-next-symbol (end) 247 | "Move point to the next symbol." 248 | (skip-syntax-forward ")" end) 249 | (if (< (point) end) 250 | (progn 251 | (forward-sexp 1) 252 | (elm-indent-skip-blanks-and-newlines-forward end)))) 253 | 254 | (defun elm-indent-next-symbol-safe (end) 255 | "Puts point to the next following symbol. 256 | If there are no more symbols in the sexp, puts point at END instead." 257 | (condition-case errlist (elm-indent-next-symbol end) 258 | (error (goto-char end)))) 259 | 260 | (defun elm-indent-separate-valdef (start end) 261 | "Return a list of positions for important parts of a valdef." 262 | (save-excursion 263 | (let (valname valname-string aft-valname 264 | guard aft-guard 265 | rhs-sign aft-rhs-sign 266 | type) 267 | ;; "parse" a valdef separating important parts 268 | (goto-char start) 269 | (setq type (elm-indent-type-at-point)) 270 | (if (or (memq type '(ident other))) ; possible start of a value def 271 | (progn 272 | (if (eq type 'ident) 273 | (progn 274 | (setq valname (match-beginning 0)) 275 | (setq valname-string (match-string 0)) 276 | (goto-char (match-end 0))) 277 | (skip-chars-forward " \t" end) 278 | (setq valname (point)) ; type = other 279 | (elm-indent-next-symbol-safe end)) 280 | (while (and (< (point) end) 281 | (setq type (elm-indent-type-at-point)) 282 | (or (memq type '(ident other)))) 283 | (if (null aft-valname) 284 | (setq aft-valname (point))) 285 | (elm-indent-next-symbol-safe end)))) 286 | (if (and (< (point) end) (eq type 'guard)) ; start of a guard 287 | (progn 288 | (setq guard (match-beginning 0)) 289 | (goto-char (match-end 0)) 290 | (while (and (< (point) end) 291 | (setq type (elm-indent-type-at-point)) 292 | (not (eq type 'rhs))) 293 | (if (null aft-guard) 294 | (setq aft-guard (point))) 295 | (elm-indent-next-symbol-safe end)))) 296 | (if (and (< (point) end) (eq type 'rhs)) ; start of a rhs 297 | (progn 298 | (setq rhs-sign (match-beginning 0)) 299 | (goto-char (match-end 0)) 300 | (if (< (point) end) 301 | (setq aft-rhs-sign (point))))) 302 | (list valname valname-string aft-valname 303 | guard aft-guard rhs-sign aft-rhs-sign)))) 304 | 305 | (defsubst elm-indent-no-otherwise (guard) 306 | "Check if there is no otherwise at GUARD." 307 | (save-excursion 308 | (goto-char guard) 309 | (not (looking-at "|[ \t]*otherwise\\>")))) 310 | 311 | (defsubst elm-indent-union-operator-p (guard) 312 | "Check if there is a union operator at GUARD." 313 | (save-excursion 314 | (goto-char guard) 315 | (and (looking-at "|") 316 | (not (looking-at "|>"))))) 317 | 318 | 319 | (defun elm-indent-guard (start end end-visible indent-info) 320 | "Find indentation information for a line starting with a guard." 321 | (save-excursion 322 | (let* ((elm-indent-info indent-info) 323 | (sep (elm-indent-separate-valdef start end)) 324 | (valname (nth 0 sep)) 325 | (guard (nth 3 sep)) 326 | (rhs-sign (nth 5 sep))) 327 | ;; push information indentation for the visible part 328 | (if (and guard (< guard end-visible) (elm-indent-no-otherwise guard)) 329 | (elm-indent-push-pos guard) 330 | (if rhs-sign 331 | (elm-indent-push-pos rhs-sign) ; probably within a data definition... 332 | (if valname 333 | (elm-indent-push-pos-offset valname)))) 334 | elm-indent-info))) 335 | 336 | (defun elm-indent-rhs (start end end-visible indent-info) 337 | "Find indentation information for a line starting with a rhs." 338 | (save-excursion 339 | (let* ((elm-indent-info indent-info) 340 | (sep (elm-indent-separate-valdef start end)) 341 | (valname (nth 0 sep)) 342 | (guard (nth 3 sep)) 343 | (rhs-sign (nth 5 sep))) 344 | ;; push information indentation for the visible part 345 | (if (and rhs-sign (< rhs-sign end-visible)) 346 | (elm-indent-push-pos rhs-sign) 347 | (if (and guard (< guard end-visible)) 348 | (elm-indent-push-pos-offset guard) 349 | (if valname ; always visible !! 350 | (elm-indent-push-pos-offset valname)))) 351 | elm-indent-info))) 352 | 353 | (defconst elm-indent-decision-table 354 | (let ((or "\\)\\|\\(")) 355 | (concat "\\(" 356 | "1.1.11" or ; 1= vn gd rh arh 357 | "1.1.10" or ; 2= vn gd rh 358 | "1.1100" or ; 3= vn gd agd 359 | "1.1000" or ; 4= vn gd 360 | "1.0011" or ; 5= vn rh arh 361 | "1.0010" or ; 6= vn rh 362 | "110000" or ; 7= vn avn 363 | "100000" or ; 8= vn 364 | "001.11" or ; 9= gd rh arh 365 | "001.10" or ;10= gd rh 366 | "001100" or ;11= gd agd 367 | "001000" or ;12= gd 368 | "000011" or ;13= rh arh 369 | "000010" or ;14= rh 370 | "000000" ;15= 371 | "\\)"))) 372 | 373 | (defun elm-indent-find-case (test) 374 | "Find the index that matches TEST in the decision table." 375 | (if (string-match elm-indent-decision-table test) 376 | ;; use the fact that the resulting match-data is a list of the form 377 | ;; (0 6 [2*(n-1) nil] 0 6) where n is the number of the matching regexp 378 | ;; so n= ((length match-data)/2)-1 379 | (- (/ (length (match-data 'integers)) 2) 1) 380 | (error "elm-indent-find-case: impossible case: %s" test))) 381 | 382 | (defun elm-indent-after-list-item-p () 383 | (with-no-warnings 384 | ;; HACK: we depend on open being dynamically bound while handling 385 | ;; indentation inside of a parenthesized expression. 386 | (when open 387 | (or (eq (char-after open) ?\() 388 | (eq (char-after open) ?\[))))) 389 | 390 | (defun elm-indent-empty (start end end-visible indent-info) 391 | "Find indentation points for an empty line." 392 | (save-excursion 393 | (let* ((elm-indent-info indent-info) 394 | (sep (elm-indent-separate-valdef start end)) 395 | (valname (pop sep)) 396 | (valname-string (pop sep)) 397 | (aft-valname (pop sep)) 398 | (guard (pop sep)) 399 | (aft-guard (pop sep)) 400 | (rhs-sign (pop sep)) 401 | (aft-rhs-sign (pop sep)) 402 | (last-line (= end end-visible)) 403 | (test (string 404 | (if valname ?1 ?0) 405 | (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) 406 | (if (and guard (< guard end-visible)) ?1 ?0) 407 | (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) 408 | (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) 409 | (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) 410 | (if (and valname-string ; special case for start keywords 411 | (string-match elm-indent-start-keywords-re valname-string)) 412 | (progn 413 | (elm-indent-push-pos valname) 414 | ;; Special case for `type' declarations. 415 | (if (string-match "\\" valname-string) 416 | (elm-indent-push-pos-offset valname) 417 | (elm-indent-push-pos-offset valname 0))) 418 | (pcase ; general case 419 | (elm-indent-find-case test) 420 | ;; "1.1.11" 1= vn gd rh arh 421 | (1 (elm-indent-push-pos valname) 422 | (elm-indent-push-pos valname valname-string) 423 | (if (elm-indent-no-otherwise guard) (elm-indent-push-pos guard "| ")) 424 | (elm-indent-push-pos aft-rhs-sign)) 425 | ;; "1.1.10" 2= vn gd rh 426 | (2 (elm-indent-push-pos valname) 427 | (elm-indent-push-pos valname valname-string) 428 | (if last-line 429 | (elm-indent-push-pos-offset guard) 430 | (if (elm-indent-no-otherwise guard) (elm-indent-push-pos guard "| ")))) 431 | ;; "1.1100" 3= vn gd agd 432 | (3 (elm-indent-push-pos valname) 433 | (elm-indent-push-pos aft-guard) 434 | (if last-line (elm-indent-push-pos-offset valname))) 435 | ;; "1.1000" 4= vn gd 436 | (4 (elm-indent-push-pos valname) 437 | (if last-line (elm-indent-push-pos-offset guard 2))) 438 | ;; "1.0011" 5= vn rh arh 439 | (5 (elm-indent-push-pos valname) 440 | (if (or (and aft-valname (= (char-after rhs-sign) ?\=)) 441 | (= (char-after rhs-sign) ?\:)) 442 | (elm-indent-push-pos valname valname-string)) 443 | (elm-indent-push-pos aft-rhs-sign)) 444 | ;; "1.0010" 6= vn rh 445 | (6 (elm-indent-push-pos valname) 446 | (elm-indent-push-pos valname valname-string) 447 | (if last-line (elm-indent-push-pos-offset valname))) 448 | ;; "110000" 7= vn avn 449 | (7 (elm-indent-push-pos valname) 450 | (elm-indent-push-pos-offset valname)) 451 | ;; "100000" 8= vn 452 | (8 (if (elm-indent-after-list-item-p) 453 | (progn 454 | (elm-indent-push-pos valname) 455 | (elm-indent-push-pos-offset valname)) 456 | 457 | (elm-indent-push-pos valname) 458 | (elm-indent-push-pos-offset valname))) 459 | ;; "001.11" 9= gd rh arh 460 | (9 (if (elm-indent-no-otherwise guard) (elm-indent-push-pos guard "| ")) 461 | (elm-indent-push-pos aft-rhs-sign)) 462 | ;; "001.10" 10= gd rh 463 | (10 (if (elm-indent-no-otherwise guard) (elm-indent-push-pos guard "| ")) 464 | (if last-line (elm-indent-push-pos-offset guard))) 465 | ;; "001100" 11= gd agd 466 | (11 (if (elm-indent-no-otherwise guard) 467 | (if (elm-indent-union-operator-p guard) 468 | (elm-indent-push-pos guard "| ") 469 | (elm-indent-push-pos guard "|> "))) 470 | (elm-indent-push-pos aft-guard)) 471 | ;; "001000" 12= gd 472 | (12 (if (elm-indent-no-otherwise guard) (elm-indent-push-pos guard "|> ")) 473 | (if last-line (elm-indent-push-pos-offset guard 2))) 474 | ;; "000011" 13= rh arh 475 | (13 (elm-indent-push-pos aft-rhs-sign)) 476 | ;; "000010" 14= rh 477 | (14 (if last-line (elm-indent-push-pos-offset rhs-sign 2 ))) 478 | ;; "000000" 15= 479 | (_ (error "elm-indent-empty: %s impossible case" test )))) 480 | elm-indent-info))) 481 | 482 | (defun elm-indent-ident (start end end-visible indent-info) 483 | "Find indentation points for a line starting with an identifier." 484 | (save-excursion 485 | (let* 486 | ((elm-indent-info indent-info) 487 | (sep (elm-indent-separate-valdef start end)) 488 | (valname (pop sep)) 489 | (valname-string (pop sep)) 490 | (aft-valname (pop sep)) 491 | (guard (pop sep)) 492 | (aft-guard (pop sep)) 493 | (rhs-sign (pop sep)) 494 | (aft-rhs-sign (pop sep)) 495 | (last-line (= end end-visible)) 496 | (diff-first ; not a function def with the same name 497 | (or (null valname-string) 498 | (not (string= (s-trim valname-string) 499 | (s-trim elm-indent-current-line-first-ident))))) 500 | 501 | ;; (is-type-def 502 | ;; (and rhs-sign (eq (char-after rhs-sign) ?\:))) 503 | (test (string 504 | (if valname ?1 ?0) 505 | (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) 506 | (if (and guard (< guard end-visible)) ?1 ?0) 507 | (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) 508 | (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) 509 | (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) 510 | (if (and valname-string ; special case for start keywords 511 | (string-match elm-indent-start-keywords-re valname-string)) 512 | (progn 513 | (elm-indent-push-pos valname) 514 | (if (string-match "\\" valname-string) 515 | ;; Special case for `type' declarations. 516 | (elm-indent-push-pos-offset valname) 517 | (if (not (string-match 518 | elm-indent-start-keywords-re 519 | elm-indent-current-line-first-ident)) 520 | (elm-indent-push-pos-offset valname)))) 521 | (if (string= elm-indent-current-line-first-ident ":") 522 | (if valname (elm-indent-push-pos valname)) 523 | (pcase ; general case 524 | (elm-indent-find-case test) 525 | ;; "1.1.11" 1= vn gd rh arh 526 | (1 (elm-indent-push-pos valname) 527 | (if diff-first (elm-indent-push-pos aft-rhs-sign))) 528 | ;; "1.1.10" 2= vn gd rh 529 | (2 (elm-indent-push-pos valname) 530 | (if last-line 531 | (elm-indent-push-pos-offset guard))) 532 | ;; "1.1100" 3= vn gd agd 533 | (3 (elm-indent-push-pos valname) 534 | (if diff-first 535 | (elm-indent-push-pos aft-guard))) 536 | ;; "1.1000" 4= vn gd 537 | (4 (elm-indent-push-pos valname) 538 | (if last-line 539 | (elm-indent-push-pos-offset guard 2))) 540 | ;; "1.0011" 5= vn rh arh 541 | (5 (elm-indent-push-pos valname) 542 | (if diff-first 543 | (elm-indent-push-pos aft-rhs-sign))) 544 | ;; "1.0010" 6= vn rh 545 | (6 (elm-indent-push-pos valname) 546 | (elm-indent-push-pos valname valname-string) 547 | (if last-line (elm-indent-push-pos-offset valname))) 548 | ;; "110000" 7= vn avn 549 | (7 (elm-indent-push-pos valname) 550 | (elm-indent-push-pos-offset valname)) 551 | ;; "100000" 8= vn 552 | (8 (elm-indent-push-pos valname) 553 | (elm-indent-push-pos-offset valname)) 554 | ;; "001.11" 9= gd rh arh 555 | (9 (elm-indent-push-pos aft-rhs-sign)) 556 | ;; "001.10" 10= gd rh 557 | (10 (if last-line 558 | (elm-indent-push-pos-offset guard))) 559 | ;; "001100" 11= gd agd 560 | (11 (if (elm-indent-no-otherwise guard) 561 | (elm-indent-push-pos aft-guard))) 562 | ;; "001000" 12= gd 563 | (12 (if last-line (elm-indent-push-pos-offset guard 2))) 564 | ;; "000011" 13= rh arh 565 | (13 (elm-indent-push-pos aft-rhs-sign)) 566 | ;; "000010" 14= rh 567 | (14 (if last-line (elm-indent-push-pos-offset rhs-sign 2))) 568 | ;; "000000" 15= 569 | (_ (error "elm-indent-ident: %s impossible case" test ))))) 570 | elm-indent-info))) 571 | 572 | (defun elm-indent-other (start end end-visible indent-info) 573 | "Find indentation points for a non-empty line starting with something other 574 | than an identifier, a guard or rhs." 575 | (save-excursion 576 | (let* ((elm-indent-info indent-info) 577 | (sep (elm-indent-separate-valdef start end)) 578 | (valname (pop sep)) 579 | (valname-string (pop sep)) 580 | (aft-valname (pop sep)) 581 | (guard (pop sep)) 582 | (aft-guard (pop sep)) 583 | (rhs-sign (pop sep)) 584 | (aft-rhs-sign (pop sep)) 585 | (last-line (= end end-visible)) 586 | (test (string 587 | (if valname ?1 ?0) 588 | (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) 589 | (if (and guard (< guard end-visible)) ?1 ?0) 590 | (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) 591 | (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) 592 | (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) 593 | (if (and valname-string ; special case for start keywords 594 | (string-match elm-indent-start-keywords-re valname-string)) 595 | (elm-indent-push-pos-offset valname) 596 | (pcase ; general case 597 | (elm-indent-find-case test) 598 | ;; "1.1.11" 1= vn gd rh arh 599 | (1 (elm-indent-push-pos aft-rhs-sign)) 600 | ;; "1.1.10" 2= vn gd rh 601 | (2 (if last-line 602 | (elm-indent-push-pos-offset guard) 603 | (elm-indent-push-pos-offset rhs-sign 2))) 604 | ;; "1.1100" 3= vn gd agd 605 | (3 (elm-indent-push-pos aft-guard)) 606 | ;; "1.1000" 4= vn gd 607 | (4 (elm-indent-push-pos-offset guard 2)) 608 | ;; "1.0011" 5= vn rh arh 609 | (5 (elm-indent-push-pos valname) 610 | (elm-indent-push-pos aft-rhs-sign)) 611 | ;; "1.0010" 6= vn rh 612 | (6 (if last-line 613 | (elm-indent-push-pos-offset valname) 614 | (elm-indent-push-pos-offset rhs-sign 2))) 615 | ;; "110000" 7= vn avn 616 | (7 (elm-indent-push-pos valname) 617 | (elm-indent-push-pos-offset valname)) 618 | ;; "100000" 8= vn 619 | (8 (elm-indent-push-pos valname)) 620 | ;; "001.11" 9= gd rh arh 621 | (9 (elm-indent-push-pos aft-rhs-sign)) 622 | ;; "001.10" 10= gd rh 623 | (10 (if last-line 624 | (elm-indent-push-pos-offset guard) 625 | (elm-indent-push-pos-offset rhs-sign 2))) 626 | ;; "001100" 11= gd agd 627 | (11 (if (elm-indent-no-otherwise guard) 628 | (elm-indent-push-pos aft-guard))) 629 | ;; "001000" 12= gd 630 | (12 (if last-line (elm-indent-push-pos-offset guard 2))) 631 | ;; "000011" 13= rh arh 632 | (13 (elm-indent-push-pos aft-rhs-sign)) 633 | ;; "000010" 14= rh 634 | (14 (if last-line (elm-indent-push-pos-offset rhs-sign 2))) 635 | ;; "000000" 15= 636 | (_ (error "elm-indent-other: %s impossible case" test )))) 637 | elm-indent-info))) 638 | 639 | (defun elm-indent-valdef-indentation (start end end-visible curr-line-type 640 | indent-info) 641 | "Find indentation information for a value definition." 642 | (let ((elm-indent-info indent-info)) 643 | (if (< start end-visible) 644 | (pcase curr-line-type 645 | ('empty (elm-indent-empty start end end-visible indent-info)) 646 | ('ident (elm-indent-ident start end end-visible indent-info)) 647 | ('guard (elm-indent-guard start end end-visible indent-info)) 648 | ('rhs (elm-indent-rhs start end end-visible indent-info)) 649 | ('comment (error "Comment indent should never happen")) 650 | ('other (elm-indent-other start end end-visible indent-info))) 651 | elm-indent-info))) 652 | 653 | (defun elm-indent-line-indentation (line-start line-end end-visible 654 | curr-line-type indent-info) 655 | "Compute indentation info between LINE-START and END-VISIBLE. 656 | Separate a line of program into valdefs between offside keywords 657 | and find indentation info for each part." 658 | (save-excursion 659 | ;; point is (already) at line-start 660 | (cl-assert (eq (point) line-start)) 661 | (let ((elm-indent-info indent-info) 662 | (start (or (elm-indent-in-comment line-start line-end) 663 | (elm-indent-in-string line-start line-end)))) 664 | (if start ; if comment at the end 665 | (setq line-end start)) ; end line before it 666 | ;; loop on all parts separated by off-side-keywords 667 | (while (and (re-search-forward elm-indent-off-side-keywords-re 668 | line-end t) 669 | (not (or (elm-indent-in-comment line-start (point)) 670 | (elm-indent-in-string line-start (point))))) 671 | (let ((beg-match (match-beginning 0)) ; save beginning of match 672 | (end-match (match-end 0))) ; save end of match 673 | ;; Do not try to find indentation points if off-side-keyword at 674 | ;; the start... 675 | (if (or (< line-start beg-match) 676 | ;; Actually, if we're looking at a "let" inside a "do", we 677 | ;; should add the corresponding indentation point. 678 | (eq (char-after beg-match) ?l)) 679 | (setq elm-indent-info 680 | (elm-indent-valdef-indentation line-start beg-match 681 | end-visible 682 | curr-line-type 683 | elm-indent-info))) 684 | ;; ...but keep the start of the line if keyword alone on the line 685 | (if (= line-end end-match) 686 | (elm-indent-push-pos beg-match)) 687 | (setq line-start end-match) 688 | (goto-char line-start))) 689 | (elm-indent-valdef-indentation line-start line-end end-visible 690 | curr-line-type elm-indent-info)))) 691 | 692 | 693 | (defun elm-indent-layout-indent-info (start contour-line) 694 | (let ((elm-indent-info nil) 695 | (curr-line-type (elm-indent-type-at-point)) 696 | line-start line-end end-visible) 697 | (save-excursion 698 | (if (eq curr-line-type 'ident) 699 | (let ; guess the type of line 700 | ((sep 701 | (elm-indent-separate-valdef 702 | (point) (line-end-position)))) 703 | ;; if the first ident is the start of a def 704 | ;; keep it in a global variable 705 | (setq elm-indent-current-line-first-ident 706 | (if (nth 5 sep) ; is there a rhs-sign 707 | (if (= (char-after (nth 5 sep)) ?\:) ;is it a typdef 708 | ":" (nth 1 sep)) 709 | "")))) 710 | (while contour-line ; explore the contour points 711 | (setq line-start (pop contour-line)) 712 | (goto-char line-start) 713 | (setq line-end (line-end-position)) 714 | (setq end-visible ; visible until the column of the 715 | (if contour-line ; next contour point 716 | (save-excursion 717 | (move-to-column 718 | (elm-indent-point-to-col (car contour-line))) 719 | (point)) 720 | line-end)) 721 | (unless (or (elm-indent-open-structure start line-start) 722 | (elm-indent-in-comment start line-start)) 723 | (setq elm-indent-info 724 | (elm-indent-line-indentation line-start line-end 725 | end-visible curr-line-type 726 | elm-indent-info))))) 727 | elm-indent-info)) 728 | 729 | (defun elm-indent-find-matching-start (regexp limit &optional pred start) 730 | (let ((open (elm-indent-open-structure limit (point)))) 731 | (if open (setq limit (1+ open)))) 732 | (unless start (setq start (point))) 733 | (when (re-search-backward regexp limit t) 734 | (let ((nestedcase (match-end 1)) 735 | (outer (or (elm-indent-in-string limit (point)) 736 | (elm-indent-in-comment limit (point)) 737 | (elm-indent-open-structure limit (point)) 738 | (if (and pred (funcall pred start)) (point))))) 739 | (cond 740 | (outer 741 | (goto-char outer) 742 | (elm-indent-find-matching-start regexp limit pred start)) 743 | (nestedcase 744 | ;; Nested case. 745 | (and (elm-indent-find-matching-start regexp limit pred) 746 | (elm-indent-find-matching-start regexp limit pred start))) 747 | (t (point)))))) 748 | 749 | 750 | (defun elm-indent-comment (open start) 751 | "Compute indent info for comments and text inside comments. 752 | OPEN is the start position of the comment in which point is." 753 | ;; Ideally we'd want to guess whether it's commented out code or 754 | ;; whether it's text. Instead, we'll assume it's text. 755 | (save-excursion 756 | (if (= open (point)) 757 | ;; We're actually just in front of a comment: align with following 758 | ;; code or with comment on previous line. 759 | (let ((prev-line-info 760 | (cond 761 | ((eq (char-after) ?\{) nil) ;Align as if it were code. 762 | ((and (forward-comment -1) 763 | (> (line-beginning-position 3) open)) 764 | ;; We're after another comment and there's no empty line 765 | ;; between us. 766 | (list (list (elm-indent-point-to-col (point))))) 767 | (t nil)))) ;Else align as if it were code 768 | ;; Align with following code. 769 | (forward-comment (point-max)) 770 | ;; There are several possible indentation points for this code-line, 771 | ;; but the only valid indentation point for the comment is the one 772 | ;; that the user will select for the code-line. Obviously we can't 773 | ;; know that, so we just assume that the code-line is already at its 774 | ;; proper place. 775 | ;; Strictly speaking "assume it's at its proper place" would mean 776 | ;; we'd just use (current-column), but since this is using info from 777 | ;; lines further down and it's common to reindent line-by-line, 778 | ;; we'll align not with the current indentation, but with the 779 | ;; one that auto-indentation "will" select. 780 | (append 781 | prev-line-info 782 | (let ((indent-info (save-excursion 783 | (elm-indent-indentation-info start))) 784 | (col (current-column))) 785 | ;; Sort the indent-info so that the current indentation comes 786 | ;; out first. 787 | (setq indent-info 788 | (sort indent-info 789 | (lambda (x y) 790 | (<= (abs (- col (car x))) (abs (- col (car y))))))) 791 | indent-info))) 792 | 793 | ;; We really are inside a comment. 794 | (if (looking-at "-}") 795 | (progn 796 | (forward-char 2) 797 | (forward-comment -1) 798 | (list (list (1+ (elm-indent-point-to-col (point)))))) 799 | (let ((offset (if (looking-at "--?") 800 | (- (match-beginning 0) (match-end 0))))) 801 | (forward-line -1) ;Go to previous line. 802 | (back-to-indentation) 803 | (if (< (point) start) (goto-char start)) 804 | 805 | (list (list (if (and comment-start-skip (looking-at comment-start-skip)) 806 | (if offset 807 | (+ 2 offset (elm-indent-point-to-col (point))) 808 | (elm-indent-point-to-col (match-end 0))) 809 | (elm-indent-point-to-col (point)))))))))) 810 | 811 | (defun elm-indent-closing-keyword (start) 812 | (let ((open (save-excursion 813 | (elm-indent-find-matching-start 814 | (pcase (char-after) 815 | (?i "\\<\\(?:\\(in\\)\\|let\\)\\>") 816 | (?o "\\<\\(?:\\(of\\)\\|case\\)\\>") 817 | (?t "\\<\\(?:\\(then\\)\\|if\\)\\>") 818 | (?e "\\<\\(?:\\(else\\)\\|if\\)\\>")) 819 | start)))) 820 | ;; For a "hanging let/case/if at EOL" we should use a different 821 | ;; indentation scheme. 822 | (save-excursion 823 | (goto-char open) 824 | (if (elm-indent-hanging-p) 825 | (setq open (elm-indent-virtual-indentation start)))) 826 | ;; FIXME: we should try and figure out if the `if' is in a `do' layout 827 | ;; before using elm-indent-thenelse. 828 | (list (list (+ (if (memq (char-after) '(?t ?e)) elm-indent-thenelse 0) 829 | (elm-indent-point-to-col open)))))) 830 | 831 | (defun elm-indent-skip-lexeme-forward () 832 | (and (zerop (skip-syntax-forward "w")) 833 | (skip-syntax-forward "_") 834 | (skip-syntax-forward "(") 835 | (skip-syntax-forward ")"))) 836 | 837 | (defun elm-indent-offset-after-info () 838 | "Return the info from `elm-indent-after-keywords' for keyword at point." 839 | (let ((id (buffer-substring 840 | (point) 841 | (save-excursion 842 | (elm-indent-skip-lexeme-forward) 843 | (point))))) 844 | (or (assoc id elm-indent-after-keywords) 845 | (car (member id elm-indent-after-keywords))))) 846 | 847 | (defun elm-indent-hanging-p () 848 | ;; A Hanging keyword is one that's at the end of a line except it's not at 849 | ;; the beginning of a line. 850 | (not (or (= (current-column) (current-indentation)) 851 | (save-excursion 852 | (let ((lexeme 853 | (buffer-substring 854 | (point) 855 | (progn (elm-indent-skip-lexeme-forward) (point))))) 856 | (or (member lexeme elm-indent-dont-hang) 857 | (> (line-end-position) 858 | (progn (forward-comment (point-max)) (point))))))))) 859 | 860 | (defun elm-indent-after-keyword-column (offset-info start &optional default) 861 | (unless offset-info 862 | (setq offset-info (elm-indent-offset-after-info))) 863 | (unless default (setq default elm-indent-offset)) 864 | (setq offset-info 865 | (if elm-indent-inhibit-after-offset '(0) (cdr-safe offset-info))) 866 | (if (not (elm-indent-hanging-p)) 867 | (elm-indent-column+offset (current-column) 868 | (or (car offset-info) default)) 869 | ;; The keyword is hanging at the end of the line. 870 | (elm-indent-column+offset 871 | (elm-indent-virtual-indentation start) 872 | (or (cadr offset-info) (car offset-info) default)))) 873 | 874 | (defun elm-indent-inside-paren-update-syntax-p (open) 875 | (let ((end (point))) 876 | (save-excursion 877 | (goto-char open) 878 | (and (not (looking-at ".*=")) 879 | (progn 880 | (forward-line) 881 | (elm-indent-skip-blanks-and-newlines-forward end) 882 | (eq (char-after) ?\|)))))) 883 | 884 | (defun elm-indent-inside-paren (open) 885 | ;; there is an open structure to complete 886 | (if (looking-at "\\s)\\|[|;,]") 887 | ;; A close-paren or a , or ; can only correspond syntactically to 888 | ;; the open-paren at `open'. So there is no ambiguity. 889 | (let* ((is-close-brace (eq (char-after) ?\})) 890 | (inside-update (elm-indent-inside-paren-update-syntax-p open))) 891 | (if (and (eq (char-after) ?\;) (eq (char-after open) ?\()) 892 | (message "Mismatched punctuation: `%c' in %c...%c" 893 | (char-after) (char-after open) 894 | (if (eq (char-after open) ?\() ?\) ?\}))) 895 | (save-excursion 896 | (goto-char open) 897 | (list (list 898 | (if (elm-indent-hanging-p) 899 | (elm-indent-virtual-indentation nil) 900 | (if (and inside-update 901 | (not is-close-brace) 902 | (eq (char-after open) ?\{)) 903 | (elm-indent-point-to-col (+ elm-indent-offset open)) 904 | (elm-indent-point-to-col open))))))) 905 | ;; There might still be layout within the open structure. 906 | (let* ((end (point)) 907 | (basic-indent-info 908 | ;; Anything else than a ) is subject to layout. 909 | (if (looking-at "\\s.\\|\\$ ") 910 | (elm-indent-point-to-col open) ; align a punct with ( 911 | (let ((follow (save-excursion 912 | (goto-char (1+ open)) 913 | (elm-indent-skip-blanks-and-newlines-forward end) 914 | (point)))) 915 | (if (= follow end) 916 | (save-excursion 917 | (goto-char open) 918 | (elm-indent-after-keyword-column nil nil 1)) 919 | (elm-indent-point-to-col (+ elm-indent-offset follow)))))) 920 | (open-column (elm-indent-point-to-col open)) 921 | (contour-line (elm-indent-contour-line (1+ open) end))) 922 | (if (null contour-line) 923 | (list (list basic-indent-info)) 924 | (let ((indent-info 925 | (elm-indent-layout-indent-info 926 | (1+ open) contour-line))) 927 | ;; Fix up indent info. 928 | (let ((base-elem (assoc open-column indent-info))) 929 | (if base-elem 930 | (progn (setcar base-elem basic-indent-info) 931 | (setcdr base-elem nil)) 932 | (if (not (eq basic-indent-info 0)) 933 | (setq indent-info (append (list (list basic-indent-info)) indent-info)) 934 | (setq indent-info (append indent-info (list (list basic-indent-info)))))) 935 | indent-info)))))) 936 | 937 | (defun elm-indent-virtual-indentation (start) 938 | "Compute the \"virtual indentation\" of text at point. 939 | The \"virtual indentation\" is the indentation that text at point would have 940 | had, if it had been placed on its own line." 941 | (let ((col (current-column)) 942 | (elm-indent-inhibit-after-offset (elm-indent-hanging-p))) 943 | (if (save-excursion (skip-chars-backward " \t") (bolp)) 944 | ;; If the text is indeed on its own line, than the virtual indent is 945 | ;; the current indentation. 946 | col 947 | ;; Else, compute the indentation that it would have had. 948 | (let ((info (elm-indent-indentation-info start)) 949 | (max -1)) 950 | ;; `info' is a list of possible indent points. Each indent point is 951 | ;; assumed to correspond to a different parse. So we need to find 952 | ;; the parse that corresponds to the case at hand (where there's no 953 | ;; line break), which is assumed to always be the 954 | ;; deepest indentation. 955 | (dolist (x info) 956 | (setq x (car x)) 957 | ;; Sometimes `info' includes the current indentation (or yet 958 | ;; deeper) by mistake, because elm-indent-indentation-info 959 | ;; wasn't designed to be called on a piece of text that is not at 960 | ;; BOL. So ignore points past `col'. 961 | (if (and (> x max) (not (>= x col))) 962 | (setq max x))) 963 | ;; In case all the indent points are past `col', just use `col'. 964 | (if (>= max 0) max col))))) 965 | 966 | (defun elm-indent-indentation-info (&optional start) 967 | "Return a list of possible indentations for the current line. 968 | These are then used by `elm-indent-cycle'. 969 | START if non-nil is a presumed start pos of the current definition." 970 | (unless start (setq start (elm-indent-start-of-def))) 971 | (let (open contour-line) 972 | (cond 973 | ;; in string? 974 | ((setq open (elm-indent-in-string start (point))) 975 | (list (list (+ (elm-indent-point-to-col open) 976 | (if (looking-at "\\\\") 0 1))))) 977 | 978 | ;; in comment ? 979 | ((setq open (elm-indent-in-comment start (point))) 980 | (elm-indent-comment open start)) 981 | 982 | ;; Closing the declaration part of a `let' or the test exp part of a case. 983 | ((looking-at "\\(?:in\\|of\\|then\\|else\\)\\>") 984 | (elm-indent-closing-keyword start)) 985 | 986 | ;; Right after a special keyword. 987 | ((save-excursion 988 | (forward-comment (- (point-max))) 989 | (when (and (not (zerop (skip-syntax-backward "w"))) 990 | (setq open (elm-indent-offset-after-info))) 991 | (list (list (elm-indent-after-keyword-column open start)))))) 992 | 993 | ;; open structure? ie ( { [ 994 | ((setq open (elm-indent-open-structure start (point))) 995 | (elm-indent-inside-paren open)) 996 | 997 | ;; full indentation 998 | ((setq contour-line (elm-indent-contour-line start (point))) 999 | (elm-indent-layout-indent-info start contour-line)) 1000 | 1001 | (t 1002 | ;; simple contour just one indentation at start 1003 | (list (list (elm-indent-point-to-col start))))))) 1004 | 1005 | (defun elm-indent-cycle () 1006 | "Indentation cycle. 1007 | 1008 | We stay in the cycle as long as the TAB key is pressed." 1009 | (interactive "*") 1010 | (let ((marker (if (> (current-column) 1011 | (current-indentation)) 1012 | (point-marker))) 1013 | (bol (progn (beginning-of-line) (point)))) 1014 | (back-to-indentation) 1015 | (unless (and (eq last-command this-command) 1016 | (eq bol (car elm-indent-last-info))) 1017 | (save-excursion 1018 | (setq elm-indent-last-info 1019 | (list bol (elm-indent-indentation-info) 0 0)))) 1020 | 1021 | (let* ((il (nth 1 elm-indent-last-info)) 1022 | (index (nth 2 elm-indent-last-info)) 1023 | (last-insert-length (nth 3 elm-indent-last-info)) 1024 | (indent-info (nth index il))) 1025 | 1026 | (indent-line-to (car indent-info)) ; insert indentation 1027 | (delete-char last-insert-length) 1028 | (setq last-insert-length 0) 1029 | (let ((text (cdr indent-info))) 1030 | (if text 1031 | (progn 1032 | (insert text) 1033 | (setq last-insert-length (length text))))) 1034 | 1035 | (setq elm-indent-last-info 1036 | (list bol il (% (1+ index) (length il)) last-insert-length)) 1037 | 1038 | (if (= (length il) 1) 1039 | (message "Sole indentation") 1040 | (message "Indent cycle (%d)..." (length il))) 1041 | 1042 | (if marker 1043 | (goto-char (marker-position marker)))))) 1044 | 1045 | (defun elm-indent-region (start end) 1046 | "Apply `elm-indent-cycle' to every line between START and END." 1047 | (save-excursion 1048 | (goto-char start) 1049 | (while (< (point) end) 1050 | (elm-indent-cycle) 1051 | (forward-line)))) 1052 | 1053 | ;;; Alignment functions 1054 | (defun elm-indent-shift-columns (dest-column region-stack) 1055 | "Shift columns in REGION-STACK to go to DEST-COLUMN. 1056 | Elements of the stack are pairs of points giving the start and end 1057 | of the regions to move." 1058 | (let (reg col diffcol reg-end) 1059 | (while (setq reg (pop region-stack)) 1060 | (setq reg-end (copy-marker (cdr reg))) 1061 | (goto-char (car reg)) 1062 | (setq col (current-column)) 1063 | (setq diffcol (- dest-column col)) 1064 | (if (not (zerop diffcol)) 1065 | (catch 'end-of-buffer 1066 | (while (<= (point) (marker-position reg-end)) 1067 | (if (< diffcol 0) 1068 | (backward-delete-char-untabify (- diffcol) nil) 1069 | (insert-char ?\ diffcol)) 1070 | (end-of-line 2) ; should be (forward-line 1) 1071 | (if (eobp) ; but it adds line at the end... 1072 | (throw 'end-of-buffer nil)) 1073 | (move-to-column col))))))) 1074 | 1075 | (defun elm-indent-align-def (p-arg type) 1076 | "Align guards or rhs within the current definition before point. 1077 | If P-ARG is t align all defs up to the mark. 1078 | TYPE is either \='guard or \='rhs." 1079 | (save-excursion 1080 | (let (start-block end-block 1081 | (maxcol (if (eq type 'rhs) elm-indent-rhs-align-column 0)) 1082 | contour sep defname defnamepos 1083 | defcol pos lastpos 1084 | regstack eqns-start start-found) 1085 | ;; find the starting and ending boundary points for alignment 1086 | (if p-arg 1087 | (if (mark) ; aligning everything in the region 1088 | (progn 1089 | (when (> (mark) (point)) (exchange-point-and-mark)) 1090 | (setq start-block 1091 | (save-excursion 1092 | (goto-char (mark)) 1093 | (line-beginning-position))) 1094 | (setq end-block 1095 | (progn (if (bolp) 1096 | (forward-line -1)) 1097 | (line-end-position)))) 1098 | (error "The mark is not set for aligning definitions")) 1099 | ;; aligning the current definition 1100 | (setq start-block (elm-indent-start-of-def)) 1101 | (setq end-block (line-end-position))) 1102 | ;; find the start of the current valdef using the contour line 1103 | ;; in reverse order because we need the nearest one from the end 1104 | (setq contour 1105 | (reverse (elm-indent-contour-line start-block end-block))) 1106 | (setq pos (car contour)) ; keep the start of the first contour 1107 | ;; find the nearest start of a definition 1108 | (while (and (not defname) contour) 1109 | (goto-char (pop contour)) 1110 | (if (elm-indent-open-structure start-block (point)) 1111 | nil 1112 | (setq sep (elm-indent-separate-valdef (point) end-block)) 1113 | (if (nth 5 sep) ; is there a rhs? 1114 | (progn (setq defnamepos (nth 0 sep)) 1115 | (setq defname (nth 1 sep)))))) 1116 | ;; start building the region stack 1117 | (if defnamepos 1118 | (progn ; there is a valdef 1119 | ;; find the start of each equation or guard 1120 | (if p-arg ; when indenting a region 1121 | ;; accept any start of id or pattern as def name 1122 | (setq defname "\\<\\|(")) 1123 | (setq defcol (elm-indent-point-to-col defnamepos)) 1124 | (goto-char pos) 1125 | (setq end-block (line-end-position)) 1126 | (catch 'top-of-buffer 1127 | (while (and (not start-found) 1128 | (>= (point) start-block)) 1129 | (if (<= (current-indentation) defcol) 1130 | (progn 1131 | (move-to-column defcol) 1132 | (if (and (looking-at defname) ; start of equation 1133 | (not (elm-indent-open-structure start-block (point)))) 1134 | (push (cons (point) 'eqn) eqns-start) 1135 | ;; found a less indented point not starting an equation 1136 | (setq start-found t))) 1137 | ;; more indented line 1138 | (back-to-indentation) 1139 | (if (and (eq (elm-indent-type-at-point) 'guard) ; start of a guard 1140 | (not (elm-indent-open-structure start-block (point)))) 1141 | (push (cons (point) 'gd) eqns-start))) 1142 | (if (bobp) 1143 | (throw 'top-of-buffer nil) 1144 | (backward-to-indentation 1)))) 1145 | ;; remove the spurious guards before the first equation 1146 | (while (and eqns-start (eq (cdar eqns-start) 'gd)) 1147 | (pop eqns-start)) 1148 | ;; go through each equation to find the region to indent 1149 | (while eqns-start 1150 | (let ((eqn (caar eqns-start))) 1151 | (setq lastpos (if (cdr eqns-start) 1152 | (save-excursion 1153 | (goto-char (cl-caadr eqns-start)) 1154 | (forward-line -1) 1155 | (line-end-position)) 1156 | end-block)) 1157 | (setq sep (elm-indent-separate-valdef eqn lastpos))) 1158 | (if (eq type 'guard) 1159 | (setq pos (nth 3 sep)) 1160 | ;; check if what follows a rhs sign is more indented or not 1161 | (let ((rhs (nth 5 sep)) 1162 | (aft-rhs (nth 6 sep))) 1163 | (if (and rhs aft-rhs 1164 | (> (elm-indent-point-to-col rhs) 1165 | (elm-indent-point-to-col aft-rhs))) 1166 | (setq pos aft-rhs) 1167 | (setq pos rhs)))) 1168 | (if pos 1169 | (progn ; update region stack 1170 | (push (cons pos (or lastpos pos)) regstack) 1171 | (setq maxcol ; find the highest column number 1172 | (max maxcol 1173 | (progn ;find the previous non-empty column 1174 | (goto-char pos) 1175 | (skip-chars-backward 1176 | " \t" 1177 | (line-beginning-position)) 1178 | (if (bolp) 1179 | ;;if on an empty prefix 1180 | (elm-indent-point-to-col pos) ;keep original indent 1181 | (1+ (elm-indent-point-to-col (point))))))))) 1182 | (pop eqns-start)) 1183 | ;; now shift according to the region stack 1184 | (if regstack 1185 | (elm-indent-shift-columns maxcol regstack))))))) 1186 | 1187 | 1188 | ;;; Insertion functions 1189 | (defun elm-indent-insert-equal () 1190 | "Insert an = sign and align the previous rhs of the current function." 1191 | (interactive "*") 1192 | (if (or (bolp) 1193 | (/= (preceding-char) ?\ )) 1194 | (insert ?\ )) 1195 | (insert "= ") 1196 | (elm-indent-align-def mark-active 'rhs)) 1197 | 1198 | 1199 | (define-obsolete-variable-alias 'elm-indent-map 'elm-indent-mode-map "2017-10-29") 1200 | 1201 | (defvar elm-indent-mode-map 1202 | (let ((map (make-sparse-keymap))) 1203 | (define-key map [?\C-c ?\C-=] 'elm-indent-insert-equal) 1204 | map)) 1205 | 1206 | ;;;###autoload 1207 | (define-minor-mode elm-indent-mode 1208 | "``Intelligent'' Elm indentation mode. 1209 | 1210 | This deals with the layout rules of Elm. 1211 | 1212 | \\[elm-indent-cycle] starts the cycle which proposes new 1213 | possibilities as long as the TAB key is pressed. Any other key 1214 | or mouse click terminates the cycle and is interpreted except for 1215 | RET which merely exits the cycle. 1216 | 1217 | Other special keys are: 1218 | 1219 | \\[elm-indent-insert-equal] 1220 | inserts an = 1221 | 1222 | Invokes `elm-indent-hook' if not nil." 1223 | :global nil 1224 | :lighter " EIndent" 1225 | :map 'elm-indent-mode-map 1226 | (if elm-indent-mode 1227 | (progn 1228 | (set (make-local-variable 'indent-line-function) 'elm-indent-cycle) 1229 | (set (make-local-variable 'indent-region-function) 'elm-indent-region)) 1230 | (kill-local-variable 'indent-line-function) 1231 | (kill-local-variable 'indent-region-function))) 1232 | 1233 | 1234 | (provide 'elm-indent) 1235 | ;;; elm-indent.el ends here 1236 | -------------------------------------------------------------------------------- /elm-interactive.el: -------------------------------------------------------------------------------- 1 | ;;; elm-interactive.el --- Run an interactive Elm session. -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2015, 2016 Bogdan Popa 4 | 5 | ;; Author: Bogdan Popa 6 | ;; URL: https://github.com/jcollard/elm-mode 7 | 8 | ;; This file is not part of GNU Emacs. 9 | 10 | ;; This file is free software; you can redistribute it and/or modify 11 | ;; it under the terms of the GNU General Public License as published by 12 | ;; the Free Software Foundation; either version 3, or (at your option) 13 | ;; any later version. 14 | 15 | ;; This file is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with this program. If not, see . 22 | 23 | ;;; Commentary: 24 | ;;; Code: 25 | (require 'ansi-color) 26 | (require 'comint) 27 | (require 'compile) 28 | (require 'cl-lib) 29 | (require 'elm-font-lock) 30 | (require 'elm-util) 31 | (require 'elm-defuns) 32 | (require 'f) 33 | (require 'json) 34 | (require 'let-alist) 35 | (require 'rx) 36 | (require 's) 37 | (require 'seq) 38 | (require 'subr-x) 39 | (require 'tabulated-list) 40 | (require 'url) 41 | (require 'thingatpt) 42 | 43 | (defvar elm-interactive--seen-prompt nil 44 | "Non-nil represents the fact that a prompt has been spotted.") 45 | (make-variable-buffer-local 'elm-interactive--seen-prompt) 46 | 47 | (defvar elm-interactive--current-project nil) 48 | (defvar elm-interactive--process-name "elm") 49 | (defvar elm-interactive--buffer-name "*elm*") 50 | (defvar elm-reactor--buffer-name "*elm-reactor*") 51 | 52 | (defcustom elm-interactive-command '("elm" "repl") 53 | "The Elm REPL command." 54 | :type '(repeat string) 55 | :group 'elm) 56 | 57 | (defcustom elm-interactive-arguments '() 58 | "Command line arguments to pass to the Elm REPL command." 59 | :type '(repeat string) 60 | :group 'elm) 61 | 62 | (defvar elm-interactive-prompt-regexp "^[>|] " 63 | "Prompt for `elm-interactive'.") 64 | 65 | (defcustom elm-reactor-command '("elm" "reactor") 66 | "The Elm Reactor command." 67 | :type '(repeat string) 68 | :group 'elm) 69 | 70 | (defcustom elm-reactor-port 8000 71 | "The Elm Reactor port." 72 | :type '(integer) 73 | :group 'elm) 74 | 75 | (defcustom elm-reactor-address "127.0.0.1" 76 | "The Elm Reactor address." 77 | :type '(string) 78 | :group 'elm) 79 | 80 | (defcustom elm-reactor-arguments `((:eval (format "--port=%s" elm-reactor-port))) 81 | "Command line arguments to pass to the Elm Reactor command. 82 | Args are expanded using `elm--expand-args'." 83 | :type '(repeat string) 84 | :group 'elm) 85 | 86 | (defvar elm-compile--buffer-name "*elm-make*") 87 | 88 | (defcustom elm-compile-command '("elm" "make") 89 | "The Elm compilation command." 90 | :type '(repeat string) 91 | :group 'elm) 92 | 93 | (defcustom elm-compile-arguments '("--output=elm.js") 94 | "Command line arguments to pass to the Elm compilation command." 95 | :type '(repeat string) 96 | :group 'elm) 97 | 98 | (defvar elm-compile-error-regexp-alist-alist 99 | '((elm-file "-- [^-]+ -+ \\(.+\\)$" 1 nil) 100 | (elm-line "^\\([0-9]+\\)|" nil 1)) 101 | "Regexps to match Elm compiler errors in compilation buffer.") 102 | 103 | (defvar elm-compile-error-regexp-alist '(elm-line elm-file)) 104 | 105 | (dolist (alist elm-compile-error-regexp-alist-alist) 106 | (add-to-list 'compilation-error-regexp-alist-alist alist)) 107 | 108 | (dolist (symbol elm-compile-error-regexp-alist) 109 | (add-to-list 'compilation-error-regexp-alist symbol)) 110 | 111 | (defcustom elm-create-package-command "elm make --yes" 112 | "The command that is used to initialize a new package definition." 113 | :type '(string) 114 | :group 'elm) 115 | 116 | (defvar elm-package--contents nil 117 | "The contents of the Elm package catalog.") 118 | 119 | (defvar elm-package--dependencies nil 120 | "The package dependencies for the current Elm package.") 121 | 122 | (defvar elm-package--cache nil 123 | "A cache for extended package information.") 124 | 125 | (defvar elm-package--marked-contents nil) 126 | 127 | (defvar elm-package--working-dir nil) 128 | 129 | (defvar elm-package-compile-buffer-name "*elm-package-compile*") 130 | 131 | (defvar elm-package-buffer-name "*elm-package*") 132 | 133 | (defcustom elm-package-command '("elm") 134 | "The Elm package command." 135 | :type '(repeat string) 136 | :group 'elm) 137 | 138 | (defcustom elm-package-arguments '("install") 139 | "Command line arguments to pass to the Elm package command." 140 | :type '(repeat string) 141 | :group 'elm) 142 | 143 | (defcustom elm-package-catalog-root 144 | "http://package.elm-lang.org/" 145 | "The root URI for the Elm package catalog." 146 | :type '(string) 147 | :group 'elm) 148 | 149 | (defvar elm-package-catalog-format 150 | [(" " 1 nil) 151 | ("Name" 30 t) 152 | ("Version" 7 nil) 153 | ("Status" 10 t) 154 | ("Summary" 80 nil)] 155 | "The format of the package list header.") 156 | 157 | (defvar elm-interactive-mode-map 158 | (let ((map (make-keymap))) 159 | (define-key map "\t" #'completion-at-point) 160 | (define-key map (kbd "C-a") #'elm-interactive-mode-beginning) 161 | (define-key map (kbd "C-c C-z") #'elm-repl-return-to-origin) 162 | map) 163 | "Keymap for Elm interactive mode.") 164 | 165 | (defvar elm-repl--origin nil 166 | "Marker for buffer/position from which we jumped to this repl.") 167 | 168 | (defcustom elm-sort-imports-on-save nil 169 | "Controls whether or not imports should be automaticaly reordered on save." 170 | :type 'boolean 171 | :group 'elm) 172 | 173 | (defvar elm-package-mode-map 174 | (let ((map (make-keymap))) 175 | (define-key map "g" #'elm-package-refresh) 176 | (define-key map "n" #'elm-package-next) 177 | (define-key map "p" #'elm-package-prev) 178 | (define-key map "v" #'elm-package-view) 179 | (define-key map "m" #'elm-package-mark) 180 | (define-key map "i" #'elm-package-mark) 181 | (define-key map "u" #'elm-package-unmark) 182 | (define-key map "x" #'elm-package-install) 183 | map) 184 | "Keymap for Elm package mode.") 185 | 186 | (defun elm-interactive-mode-beginning () 187 | "Go to the start of the line." 188 | (interactive) 189 | (beginning-of-line) 190 | (goto-char (+ 2 (point)))) 191 | 192 | (defun elm-interactive--get-process-buffer () 193 | "Get the REPL process buffer." 194 | (get-buffer-process elm-interactive--buffer-name)) 195 | 196 | (defun elm-interactive--spot-prompt (_string) 197 | "Spot the prompt, _STRING is ignored." 198 | (let ((proc (elm-interactive--get-process-buffer))) 199 | (when proc 200 | (save-excursion 201 | (goto-char (process-mark proc)) 202 | (if (re-search-backward comint-prompt-regexp 203 | (line-beginning-position) t) 204 | (setq elm-interactive--seen-prompt t)))))) 205 | 206 | (defun elm-interactive--wait-for-prompt (proc &optional timeout) 207 | "Wait until PROC sends us a prompt or TIMEOUT. 208 | The process PROC should be associated to a comint buffer. 209 | 210 | Stolen from ‘haskell-mode’." 211 | (with-current-buffer (process-buffer proc) 212 | (while (progn 213 | (goto-char comint-last-input-end) 214 | (not (or elm-interactive--seen-prompt 215 | (setq elm-interactive--seen-prompt 216 | (re-search-forward comint-prompt-regexp nil t)) 217 | (not (accept-process-output proc timeout)))))) 218 | (unless elm-interactive--seen-prompt 219 | (error "Can't find the prompt")))) 220 | 221 | (defun elm-interactive--send-command (command) 222 | "Send a COMMAND to the REPL." 223 | (let ((proc (elm-interactive--get-process-buffer))) 224 | (with-current-buffer (process-buffer proc) 225 | (elm-interactive--wait-for-prompt proc 10) 226 | (goto-char (process-mark proc)) 227 | (insert-before-markers command) 228 | (move-marker comint-last-input-end (point)) 229 | (setq elm-interactive--seen-prompt nil) 230 | (comint-send-string proc command)))) 231 | 232 | (defun elm-interactive-kill-current-session () 233 | "Stop the current REPL session and delete its buffer." 234 | (interactive) 235 | (when (and elm-interactive--current-project 236 | (get-buffer-process elm-interactive--buffer-name) 237 | (not (equal elm-interactive--current-project (elm--find-dependency-file-path))) 238 | (y-or-n-p "This will kill your existing REPL session. Continue? ")) 239 | (delete-process elm-interactive--buffer-name) 240 | (kill-buffer elm-interactive--buffer-name))) 241 | 242 | ;;;###autoload 243 | (define-derived-mode elm-interactive-mode comint-mode "Elm Interactive" 244 | "Major mode for `elm-interactive'. 245 | 246 | \\{elm-interactive-mode-map}" 247 | 248 | (setq-local comint-prompt-regexp elm-interactive-prompt-regexp) 249 | (setq-local comint-prompt-read-only t) 250 | (setq-local comint-use-prompt-regexp t) 251 | 252 | (add-hook 'comint-output-filter-functions #'elm-interactive--spot-prompt nil t) 253 | 254 | (elm--font-lock-enable)) 255 | 256 | ;;;###autoload 257 | (defun elm-interactive () 258 | "Run an inferior instance of `elm-repl' inside Emacs." 259 | (interactive) 260 | (elm-interactive-kill-current-session) 261 | (let* ((default-directory (elm--find-dependency-file-path)) 262 | (origin (point-marker)) 263 | (cmd (append (elm--ensure-list elm-interactive-command) elm-interactive-arguments))) 264 | 265 | (setq elm-interactive--current-project default-directory) 266 | (let ((buffer (get-buffer-create elm-interactive--buffer-name))) 267 | (apply #'make-comint-in-buffer elm-interactive--process-name buffer 268 | (car cmd) nil (cdr cmd)) 269 | (with-current-buffer buffer 270 | (elm-interactive-mode) 271 | (setq-local elm-repl--origin origin)) 272 | (pop-to-buffer buffer)))) 273 | 274 | ;;;###autoload 275 | (define-obsolete-function-alias 'run-elm-interactive 'elm-interactive "2020-04") 276 | 277 | (defun elm-repl-return-to-origin () 278 | "Jump back to the location from which we last jumped to the repl." 279 | (interactive) 280 | (let* ((pos elm-repl--origin) 281 | (buffer (get-buffer (marker-buffer pos)))) 282 | (when buffer 283 | (pop-to-buffer buffer) 284 | (goto-char pos)))) 285 | 286 | ;;;###autoload 287 | (defun elm-repl-load () 288 | "Load an interactive REPL if there isn't already one running. 289 | Changes the current root directory to be the directory with the closest 290 | package json if one exists otherwise sets it to be the working directory 291 | of the file specified." 292 | (interactive) 293 | (save-buffer) 294 | (let ((import-statement (elm--build-import-statement))) 295 | (elm-interactive) 296 | (elm-interactive--send-command ":reset\n") 297 | (elm-interactive--send-command import-statement))) 298 | 299 | ;;;###autoload 300 | (defun elm-repl-push (beg end) 301 | "Push the region from BEG to END to an interactive REPL." 302 | (interactive "r") 303 | (let* ((to-push (buffer-substring-no-properties beg end)) 304 | (lines (split-string (s-trim-right to-push) "\n"))) 305 | (elm-interactive) 306 | (dolist (line lines) 307 | (elm-interactive--send-command (concat line " \\\n"))) 308 | (elm-interactive--send-command "\n"))) 309 | 310 | ;;;###autoload 311 | (defun elm-repl-push-decl () 312 | "Push the current top level declaration to the REPL." 313 | (interactive) 314 | (let ((lines (elm--get-decl))) 315 | (elm-interactive) 316 | (dolist (line lines) 317 | (elm-interactive--send-command (concat line " \\\n"))) 318 | (elm-interactive--send-command "\n"))) 319 | 320 | (defun elm--ensure-list (v) 321 | "Return V if it is a list, otherwise a single-element list containing V." 322 | (if (consp v) 323 | v 324 | (list v))) 325 | 326 | (defun elm--expand-args (args) 327 | "Expand any `(:eval ...)' entries in ARGS by evaluating them." 328 | (mapcar (lambda (arg) 329 | (pcase arg 330 | (`(:eval ,sexp) (eval sexp)) 331 | (_ arg))) 332 | args)) 333 | 334 | ;;; Reactor: 335 | ;;;###autoload 336 | (defun elm-reactor () 337 | "Run the Elm reactor process." 338 | (interactive) 339 | (let ((default-directory (elm--find-dependency-file-path)) 340 | (cmd (elm--expand-args (append (elm--ensure-list elm-reactor-command) elm-reactor-arguments)))) 341 | (with-current-buffer (get-buffer-create elm-reactor--buffer-name) 342 | (comint-mode) 343 | (ansi-color-for-comint-mode-on) 344 | (let ((proc (get-buffer-process (current-buffer)))) 345 | (if (and proc (process-live-p proc)) 346 | (progn 347 | (message "Restarting elm-reactor") 348 | (delete-process proc)) 349 | (message "Starting elm-reactor"))) 350 | 351 | (let ((proc (apply #'start-process "elm reactor" elm-reactor--buffer-name 352 | (car cmd) (cdr cmd)))) 353 | (when proc 354 | (set-process-filter proc 'comint-output-filter)))))) 355 | 356 | ;;;###autoload 357 | (define-obsolete-function-alias 'run-elm-reactor 'elm-reactor "2020-04") 358 | 359 | (defun elm-reactor--browse (path &optional debug) 360 | "Open (reactor-relative) PATH in browser with optional DEBUG. 361 | 362 | Runs `elm-reactor' first." 363 | (elm-reactor) 364 | (browse-url (format "http://localhost:%s/%s%s" elm-reactor-port path (if debug "?debug" "")))) 365 | 366 | ;;;###autoload 367 | (defun elm-preview-buffer (debug) 368 | "Preview the current buffer using Elm reactor (in debug mode if DEBUG is truthy)." 369 | (interactive "P") 370 | (let* ((fname (buffer-file-name)) 371 | (deppath (elm--find-dependency-file-path)) 372 | (path (f-relative fname deppath))) 373 | (elm-reactor--browse path debug))) 374 | 375 | ;;;###autoload 376 | (defun elm-preview-main (debug) 377 | "Preview the main elm file using Elm reactor (in debug mode if DEBUG is truthy)." 378 | (interactive "P") 379 | (elm-reactor--browse (elm--find-main-file) debug)) 380 | 381 | 382 | ;;; Make: 383 | (defun elm-compile--command (file &optional output json) 384 | "Generate a command that will compile FILE into OUTPUT. 385 | When JSON is non-nil, JSON reporting will be enabled." 386 | (let ((elm-compile-arguments 387 | (if output 388 | (append (cl-remove-if (apply-partially #'string-prefix-p "--output=") elm-compile-arguments) 389 | (list (concat "--output=" (expand-file-name output)))) 390 | elm-compile-arguments))) 391 | (s-join " " 392 | (append (elm--ensure-list elm-compile-command) 393 | (mapcar 'shell-quote-argument 394 | (append (list file) 395 | elm-compile-arguments 396 | (when json 397 | (list "--report=json")))))))) 398 | 399 | (defun elm-compile--filter () 400 | "Filter function for compilation output." 401 | (ansi-color-apply-on-region (point-min) (point-max))) 402 | 403 | (define-compilation-mode elm-compilation-mode "Elm-Compile" 404 | "Elm compilation mode." 405 | (progn 406 | (add-hook 'compilation-filter-hook 'elm-compile--filter nil t))) 407 | 408 | (defun elm-compile--file (file &optional output) 409 | "Compile FILE into OUTPUT." 410 | (let ((default-directory (elm--find-dependency-file-path))) 411 | (with-current-buffer 412 | (compilation-start 413 | (elm-compile--command file output) 414 | 'elm-compilation-mode 415 | (lambda (_) elm-compile--buffer-name))))) 416 | 417 | (defun elm-compile--file-json (file &optional output) 418 | "Compile FILE into OUTPUT and return the JSON report. 419 | The report is a list of elements sorted by their occurrence order 420 | in the file." 421 | (let* ((default-directory (elm--find-dependency-file-path)) 422 | (report (shell-command-to-string 423 | (elm-compile--command file output t)))) 424 | (when (string-prefix-p "[" report) 425 | (let ((json (json-read-from-string report))) 426 | (cl-flet ((start-line (o) (let-alist o .region.start.line))) 427 | (cl-sort (append json nil) (lambda (o1 o2) (< (start-line o1) (start-line o2))))))))) 428 | 429 | (defun elm-compile--temporary () 430 | "Get a compilation report for the current buffer." 431 | (let* ((input (make-temp-file "elm-comp-in-" nil ".elm")) 432 | (output (make-temp-file "elm-comp-out-" nil ".js"))) 433 | (unwind-protect 434 | (progn 435 | (write-region (point-min) (point-max) input) 436 | (elm-compile--file-json input output)) 437 | (delete-file output) 438 | (delete-file input)))) 439 | 440 | 441 | ;;;###autoload 442 | (defun elm-compile-buffer (&optional output) 443 | "Compile the current buffer into OUTPUT." 444 | (interactive 445 | (when current-prefix-arg 446 | (list (read-file-name "Output to: ")))) 447 | (save-some-buffers) 448 | (elm-compile--file (elm--buffer-local-file-name) output)) 449 | 450 | ;;;###autoload 451 | (defun elm-compile-main (&optional output) 452 | "Compile the main elm file into OUTPUT." 453 | (interactive 454 | (when current-prefix-arg 455 | (list (read-file-name "Output to: ")))) 456 | (elm-compile--file (elm--find-main-file) output)) 457 | 458 | (defun elm-compile--ensure-saved () 459 | "Ensure the current buffer has been saved." 460 | (when (buffer-modified-p) 461 | (if (y-or-n-p "Save current buffer? ") 462 | (save-buffer) 463 | (error "You must save your changes first")))) 464 | 465 | ;;;###autoload 466 | (defun elm-compile-clean-imports (&optional prompt) 467 | "Remove unused imports from the current buffer. 468 | Optionally PROMPT before deleting." 469 | (interactive "P") 470 | (let* ((report (elm-compile--temporary)) 471 | (line-offset 0)) 472 | (dolist (ob report) 473 | (let-alist ob 474 | (when (equal .tag "unused import") 475 | (save-excursion 476 | (goto-char 0) 477 | (forward-line (- .region.start.line 1 line-offset)) 478 | (when (or (not prompt) (y-or-n-p "Delete this import? ")) 479 | (dotimes (_ (1+ (- .region.end.line 480 | .region.start.line))) 481 | (kill-whole-line) 482 | (setq line-offset (1+ line-offset)))))))))) 483 | 484 | (defconst elm-import--pattern 485 | (let* ((upper-word '(seq upper (0+ alnum))) 486 | (lower-word '(seq lower (0+ alnum))) 487 | (ws '(or space "\n")) 488 | (exposing-item `(or ,lower-word 489 | (seq ,upper-word 490 | (opt (0+ ,ws) "(" (0+ ,ws) 491 | (or ".." (seq ,upper-word (0+ (0+ ,ws) "," (0+ ,ws) ,upper-word))) 492 | (0+ ,ws) ")")))) 493 | (exposing-list `(seq ,exposing-item (0+ (0+ ,ws) "," (0+ ,ws) ,exposing-item)))) 494 | ;; TODO: we don't yet allow for comments on lines within an import statement 495 | (rx-to-string 496 | `(seq line-start 497 | "import" (1+ ,ws) (group ,upper-word (0+ "." ,upper-word)) 498 | (opt (1+ ,ws) "as" (1+ ,ws) (group ,upper-word)) 499 | (opt (1+ ,ws) "exposing" (1+ ,ws) "(" (0+ ,ws) (group (or ".." ,exposing-list)) (0+ ,ws) ")") 500 | (0+ space) 501 | line-end)) ) 502 | "Regex to match elm import (including multiline). 503 | Import consists of the word \"import\", real package name, and optional 504 | \"as\" part, and \"exposing\" part, which must occur in that (standard) order. 505 | Each is captured as a group.") 506 | 507 | ;;;###autoload 508 | (defun elm-sort-imports () 509 | "Sort the import list in the current buffer." 510 | (interactive) 511 | (save-excursion 512 | (goto-char (point-min)) 513 | (while (re-search-forward elm-import--pattern nil t) 514 | ;; Sort block of contiguous imports, separated by empty lines 515 | (let ((start (match-beginning 0))) 516 | (forward-char 1) ;; Move past newline 517 | (while (looking-at elm-import--pattern) 518 | (goto-char (1+ (match-end 0)))) 519 | (let ((end (point))) 520 | (sort-regexp-fields nil elm-import--pattern "\\1" start end)))))) 521 | 522 | 523 | ;;;###autoload 524 | (defun elm-compile-add-annotations (&optional prompt) 525 | "Add missing type annotations to the current buffer. 526 | Optionally PROMPT before inserting." 527 | (interactive "P") 528 | (let* ((report (elm-compile--temporary)) 529 | (line-offset 0)) 530 | (dolist (ob report) 531 | (let-alist ob 532 | (when (equal .tag "missing type annotation") 533 | ;; Drop the first 2 lines from .details since they contain the warning itself. 534 | (let ((annotation (s-join "\n" (cdr (cdr (s-split "\n" .details)))))) 535 | (goto-char 0) 536 | (forward-line (+ line-offset (1- .region.start.line))) 537 | (setq line-offset (1+ line-offset)) 538 | (when (or (not prompt) (y-or-n-p (format "Add annotation '%s'? " annotation))) 539 | (princ (format "%s\n" annotation) (current-buffer))))))))) 540 | 541 | ;;; Package: 542 | ;;;###autoload 543 | (defun elm-create-package () 544 | "Generate a new package definition in the current directory." 545 | (interactive) 546 | (when (elm--has-dependency-file) 547 | (error "Elm-package.json already exists")) 548 | (let* ((default-directory (elm--find-dependency-file-path))) 549 | (message "Creating elm package definition. This might take a minute...") 550 | (shell-command elm-create-package-command))) 551 | 552 | (defun elm-package--build-uri (&rest segments) 553 | "Build a URI by combining the package catalog root and SEGMENTS." 554 | (concat elm-package-catalog-root (s-join "/" segments))) 555 | 556 | (defun elm-package--format-entry (entry index) 557 | "Format a \='(INDEX ENTRY) list for display in the package listing." 558 | (let-alist entry 559 | (let ((mark (if (member index elm-package--marked-contents) 560 | "*" 561 | "")) 562 | (button (list .name . ())) 563 | (status (if (member .name elm-package--dependencies) 564 | "dependency" 565 | "available"))) 566 | (list index (vector mark button (elt .versions 0) status .summary))))) 567 | 568 | (defun elm-package--entries () 569 | "Return the formatted package list." 570 | (seq-map-indexed #'elm-package--format-entry elm-package--contents)) 571 | 572 | (defun elm-package--get-marked-packages () 573 | "Get packages that are marked for installation." 574 | (mapcar (lambda (id) 575 | (let-alist (nth id elm-package--contents) 576 | .name)) 577 | elm-package--marked-contents)) 578 | 579 | (defun elm-package--get-marked-install-commands () 580 | "Get a list of the commands required to install the marked packages." 581 | (mapcar (lambda (package) 582 | (s-join " " (append (elm--ensure-list elm-package-command) elm-package-arguments (list package)))) 583 | (elm-package--get-marked-packages))) 584 | 585 | (defun elm-package--read-dependencies () 586 | "Read the current package's dependencies." 587 | (setq elm-package--working-dir (elm--find-dependency-file-path)) 588 | (let-alist (elm--read-dependency-file) 589 | (setq elm-package--dependencies 590 | (mapcar (lambda (dep) (symbol-name (car dep))) 591 | (if (consp .dependencies.direct) 592 | (append .dependencies.direct .dependencies.indirect) 593 | .dependencies))))) 594 | 595 | (defun elm-package--read-json (uri) 596 | "Read a JSON file from a URI." 597 | (with-current-buffer (url-retrieve-synchronously uri) 598 | (goto-char (point-min)) 599 | (re-search-forward "^ *$") 600 | (json-read))) 601 | 602 | (defun elm-package--read-package () 603 | "Read a package from the minibuffer." 604 | (completing-read "Package: " elm-package--dependencies nil t)) 605 | 606 | (defun elm-package--read-module (package) 607 | "Read a module from PACKAGE from the minibuffer." 608 | (completing-read "Module: " (elm-package-modules package) nil t)) 609 | 610 | (defun elm-package--read-module-definition (package module) 611 | "Read a definition from PACKAGE and MODULE from the minibuffer." 612 | (completing-read "Definition: " (elm-package-definitions package module) nil t)) 613 | 614 | (defun elm-package-refresh-package (package version) 615 | "Refresh the cache for PACKAGE with VERSION." 616 | (let ((documentation-uri 617 | (elm-package--build-uri "packages" package version "docs.json"))) 618 | (setq elm-package--cache 619 | (cons `(,package . ,(elm-package--read-json documentation-uri)) 620 | elm-package--cache)))) 621 | 622 | (defun elm-package-latest-version (package) 623 | "Get the latest version of PACKAGE." 624 | (let ((entry (assoc (intern-soft package) elm-package--contents))) 625 | (if (not entry) 626 | (error "Package not found") 627 | (let ((versions (cdr entry))) 628 | (elt versions 0))))) 629 | 630 | (defun elm-package--ensure-cached (package) 631 | "Ensure that PACKAGE has been cached." 632 | (unless (assoc package elm-package--cache) 633 | (elm-package-refresh-package package (elm-package-latest-version package)))) 634 | 635 | (defun elm-package-modules (package) 636 | "Get PACKAGE's module list." 637 | (elm-package--ensure-cached package) 638 | (sort 639 | (mapcar (lambda (module) 640 | (let-alist module .name)) 641 | (cdr (assoc package elm-package--cache))) 642 | #'string<)) 643 | 644 | (defun elm-package--select-module (package module-name) 645 | "Select a PACKAGE's MODULE-NAME from the cache." 646 | (elm-package--ensure-cached package) 647 | (elt (cl-remove-if-not 648 | (lambda (module) 649 | (let-alist module (equal module-name .name))) 650 | (cdr (assoc package elm-package--cache))) 0)) 651 | 652 | (defun elm-package-definitions (package module-name) 653 | "Get all of PACKAGE's MODULE-NAME's definitions." 654 | (let-alist (elm-package--select-module package module-name) 655 | (let* ((extract (lambda (x) 656 | (let ((name (cdr (assq 'name x)))) 657 | (cons name nil)))) 658 | (aliases (mapcar extract .aliases)) 659 | (types (mapcar extract .types)) 660 | (values (mapcar extract .values))) 661 | (append aliases types values)))) 662 | 663 | (defun elm-package-definition (package module-name definition-name) 664 | "Get documentation from PACKAGE's MODULE-NAME for DEFINITION-NAME." 665 | (let-alist (elm-package--select-module package module-name) 666 | (elt (cl-remove-if-not 667 | (lambda (x) 668 | (equal definition-name (cdr (assq 'name x)))) 669 | (vconcat .aliases .types .values)) 670 | 0))) 671 | 672 | (defun elm-package-refresh () 673 | "Refresh the package catalog's contents." 674 | (interactive) 675 | (with-current-buffer elm-package-buffer-name 676 | (elm-package--read-dependencies) 677 | (tabulated-list-print :remember-pos))) 678 | 679 | (defun elm-package-prev (&optional n) 680 | "Goto (Nth) previous package." 681 | (interactive "p") 682 | (elm-package-next (- n)) 683 | (forward-line 0) 684 | (forward-button 1)) 685 | 686 | (defun elm-package-next (&optional n) 687 | "Goto (Nth) next package." 688 | (interactive "p") 689 | (dotimes (_ (abs n)) 690 | (let ((d (cl-signum n))) 691 | (forward-line (if (> n 0) 1 0)) 692 | (when (eobp) 693 | (forward-line -1)) 694 | (forward-button d)))) 695 | 696 | (defun elm-package-mark () 697 | "Mark the package at point." 698 | (interactive) 699 | (let ((id (tabulated-list-get-id))) 700 | (when id 701 | (setq elm-package--marked-contents (cons id elm-package--marked-contents)) 702 | (elm-package-next 1) 703 | (elm-package-refresh)))) 704 | 705 | (defun elm-package-unmark () 706 | "Unmark the package at point." 707 | (interactive) 708 | (let ((id (tabulated-list-get-id))) 709 | (when id 710 | (setq elm-package--marked-contents 711 | (seq-remove (lambda (x) (= id x)) 712 | elm-package--marked-contents)) 713 | (elm-package-next 1) 714 | (elm-package-refresh)))) 715 | 716 | (defun elm-package-view () 717 | "View the package at point in a browser." 718 | (interactive) 719 | (let ((id (tabulated-list-get-id))) 720 | (when id 721 | (let-alist (nth id elm-package--contents) 722 | (browse-url (elm-package--build-uri "packages" .name (elt .versions 0))))))) 723 | 724 | (defun elm-package--install-sentinel (_proc _msg) 725 | "Refreshes the package buffer on _PROC exit, ignoring _MSG." 726 | (elm-package-refresh)) 727 | 728 | (defun elm-package-install () 729 | "Install the marked packages." 730 | (interactive) 731 | (unless elm-package--marked-contents 732 | (error "Nothing to install")) 733 | (let* ((and (elm--shell-and-command)) 734 | (command-to-run (s-join and (elm-package--get-marked-install-commands)))) 735 | (when (yes-or-no-p (concat "Install " (s-join ", " (elm-package--get-marked-packages)) " ?")) 736 | (let* ((default-directory elm-package--working-dir) 737 | (compilation-buffer-name-function (lambda (_) elm-package-compile-buffer-name)) 738 | (compilation-buffer (compile command-to-run t))) 739 | (setq elm-package--marked-contents nil) 740 | (set-process-sentinel (get-buffer-process compilation-buffer) 741 | #'elm-package--install-sentinel))))) 742 | 743 | ;;;###autoload 744 | (defun elm-package-catalog (refresh) 745 | "Show the package catalog, refreshing the list if REFRESH is truthy." 746 | (interactive "P") 747 | (elm--assert-dependency-file) 748 | (when (or refresh (not elm-package--contents)) 749 | (elm-package-refresh-contents)) 750 | (let ((buffer (get-buffer-create elm-package-buffer-name))) 751 | (pop-to-buffer buffer) 752 | (elm-package--read-dependencies) 753 | (elm-package-mode))) 754 | 755 | ;;;###autoload 756 | (defun elm-package-refresh-contents () 757 | "Refresh the package list." 758 | (interactive) 759 | (elm--assert-dependency-file) 760 | (let* ((all-packages (elm-package--build-uri "all-packages"))) 761 | (with-current-buffer (url-retrieve-synchronously all-packages) 762 | (goto-char (point-min)) 763 | (re-search-forward "^ *$") 764 | (setq elm-package--marked-contents nil) 765 | (setq elm-package--contents 766 | (cl-loop for (name . versions) in (json-read) 767 | collect `((name . ,(symbol-name name)) 768 | (versions . ,(nreverse versions)) 769 | (summary . ""))))))) 770 | 771 | ;;;###autoload 772 | (defun elm-import (refresh) 773 | "Import a module, refreshing if REFRESH is truthy." 774 | (interactive "P") 775 | (elm--assert-dependency-file) 776 | (when (or refresh (not elm-package--contents)) 777 | (elm-package-refresh-contents)) 778 | (elm-package--read-dependencies) 779 | (let* ((package (elm-package--read-package)) 780 | (module (elm-package--read-module package)) 781 | (statement (concat "import " module)) 782 | (statement (read-string "Import statement: " statement))) 783 | (save-excursion 784 | (goto-char (point-min)) 785 | (if (re-search-forward "^import " nil t) 786 | (beginning-of-line) 787 | (forward-line 1) 788 | (insert "\n")) 789 | (insert (concat statement "\n")))) 790 | (elm-sort-imports)) 791 | 792 | 793 | (defun elm-imports--list (buffer) 794 | "Find all imports in the current BUFFER. 795 | Return an alist of (FULL_NAME . (\='as AS \='exposing EXPOSING), where 796 | EXPOSING" 797 | (with-current-buffer buffer 798 | (save-excursion 799 | (save-match-data 800 | (let ((matches ())) 801 | (goto-char (point-min)) 802 | (while (re-search-forward elm-import--pattern nil t) 803 | (let ((full (substring-no-properties (match-string 1))) 804 | (as (match-string 2)) 805 | (exposing (match-string 3))) 806 | (push (list full 807 | (cons 'as (if as (substring-no-properties as) full)) 808 | (cons 'exposing exposing)) 809 | matches))) 810 | matches))))) 811 | 812 | (defun elm-imports--aliased (imports-list name full-name) 813 | "Given IMPORTS-LIST, return the local name for function with NAME and FULL-NAME." 814 | (let* ((suffix (concat "." name)) 815 | (module-name (s-chop-suffix suffix full-name)) 816 | (imports-entry (cl-assoc module-name imports-list :test 'string-equal))) 817 | (let-alist imports-entry 818 | (if (or (string-equal "Basics" module-name) 819 | (when .exposing 820 | (or (string-equal .exposing "..") 821 | (cl-find name (s-split " *, *" .exposing) :test 'string-equal)))) 822 | name 823 | (concat (or .as module-name) suffix))))) 824 | 825 | ;;;###autoload 826 | (defun elm-expose-at-point () 827 | "Exposes identifier at point." 828 | (interactive) 829 | (save-excursion 830 | ;; If already at the beginning of defun then 831 | ;; elm-beginning-of-defun will go to previous defun. Thus we go 832 | ;; to the beginning of next defun and come back to make sure we 833 | ;; will arrive at correct place. 834 | (elm-end-of-defun) 835 | (elm-beginning-of-defun) 836 | (let* (case-fold-search 837 | (expose (cond 838 | ((looking-at (rx "type" (+ space) "alias" (+ space))) 839 | (goto-char (match-end 0)) 840 | (word-at-point)) 841 | ((looking-at (rx "type" (+ space))) 842 | (goto-char (match-end 0)) 843 | (concat (word-at-point) 844 | (if (y-or-n-p "Expose constructors? ") 845 | "(..)" 846 | ""))) 847 | ((or (looking-at (rx (or "port" "module" "import") (+ space))) 848 | (null (word-at-point))) 849 | (user-error "No identifier at point")) 850 | (t (word-at-point))))) 851 | (goto-char (point-min)) 852 | (if (re-search-forward (rx bol "module" (+ (or space)) 853 | upper (* (or word (syntax symbol))) 854 | (+ (any space ?\n)) "exposing" (+ (any space ?\n)) "(") 855 | nil t) 856 | (progn 857 | (goto-char (match-end 0)) 858 | (insert expose) 859 | (when (looking-at (rx (* (any space ?\n)) word)) 860 | (insert ", "))) 861 | (error "Couldn't find module declaration"))))) 862 | 863 | (defun elm-documentation--show (documentation) 864 | "Show DOCUMENTATION in a help buffer." 865 | (let-alist documentation 866 | (help-setup-xref (list #'elm-documentation--show documentation) nil) 867 | (save-excursion 868 | (with-help-window (help-buffer) 869 | (with-current-buffer (help-buffer) 870 | (point-min) 871 | (insert (propertize .name 'face 'font-lock-function-name-face)) 872 | (when .args 873 | (insert (concat " " (s-join " " .args)))) 874 | (when .cases 875 | (let ((first t)) 876 | (mapc 877 | (lambda (case) 878 | (if first 879 | (insert "\n = ") 880 | (insert "\n | ")) 881 | (insert (propertize (elt case 0) 'face 'font-lock-function-name-face)) 882 | (insert (concat " " (s-join " " (elt case 1)))) 883 | (setq first nil)) 884 | .cases))) 885 | (when .type 886 | (insert " : ") 887 | (insert (propertize .type 'face 'font-lock-type-face))) 888 | (insert (concat "\n\n" (s-trim-left .comment))))))) ) 889 | 890 | ;;;###autoload 891 | (defun elm-documentation-lookup (refresh) 892 | "Lookup the documentation for a function, refreshing if REFRESH is truthy." 893 | (interactive "P") 894 | (elm--assert-dependency-file) 895 | (when (or refresh (not elm-package--contents)) 896 | (elm-package-refresh-contents)) 897 | (elm-package--read-dependencies) 898 | (let* ((package (elm-package--read-package)) 899 | (module (elm-package--read-module package)) 900 | (definition (elm-package--read-module-definition package module)) 901 | (documentation (elm-package-definition package module definition))) 902 | (elm-documentation--show documentation))) 903 | 904 | ;;;###autoload 905 | (define-derived-mode elm-package-mode tabulated-list-mode "Elm Package" 906 | "Special mode for elm-package. 907 | 908 | \\{elm-package-mode-map}" 909 | 910 | (buffer-disable-undo) 911 | 912 | (setq truncate-lines t 913 | 914 | tabulated-list-format elm-package-catalog-format 915 | tabulated-list-entries #'elm-package--entries) 916 | 917 | (tabulated-list-init-header) 918 | (tabulated-list-print)) 919 | 920 | 921 | ;;;###autoload 922 | (defun elm-test-project () 923 | "Run the elm-test command on the current project." 924 | (interactive) 925 | (let ((default-directory (elm--find-elm-test-root-directory)) 926 | (compilation-buffer-name-function (lambda (_) "*elm-test*"))) 927 | (compile "elm-test"))) 928 | 929 | 930 | (provide 'elm-interactive) 931 | ;;; elm-interactive.el ends here 932 | -------------------------------------------------------------------------------- /elm-mode.el: -------------------------------------------------------------------------------- 1 | ;;; elm-mode.el --- Major mode for Elm -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2013, 2014 Joseph Collard 4 | ;; Copyright (C) 2015, 2016 Bogdan Popa 5 | 6 | ;; Author: Joseph Collard 7 | ;; Package-Requires: ((f "0.17") (s "1.7.0") (emacs "25.1") (seq "2.23") (reformatter "0.3")) 8 | ;; URL: https://github.com/jcollard/elm-mode 9 | ;; Package-Version: 0-snapshot 10 | 11 | ;; This file is not part of GNU Emacs. 12 | 13 | ;; This file is free software; you can redistribute it and/or modify 14 | ;; it under the terms of the GNU General Public License as published by 15 | ;; the Free Software Foundation; either version 3, or (at your option) 16 | ;; any later version. 17 | 18 | ;; This file is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | 23 | ;; You should have received a copy of the GNU General Public License 24 | ;; along with this program. If not, see . 25 | 26 | ;;; Commentary: 27 | 28 | ;; Provides a major mode for editing Elm source code, and working with 29 | ;; common core and third-party Elm tools including the compiler, repl, 30 | ;; elm-format and more. 31 | 32 | ;;; Code: 33 | (require 'elm-tags) 34 | (require 'elm-defuns) 35 | (require 'elm-format) 36 | (require 'elm-imenu) 37 | (require 'elm-indent) 38 | (require 'elm-indent-simple) 39 | (require 'elm-interactive) 40 | (require 'elm-font-lock) 41 | (require 'project) 42 | (require 'rx) 43 | 44 | (defgroup elm nil 45 | "Support for the elm programming language." 46 | :link '(url-link :tag "Github" "https://github.com/jcollard/elm-mode") 47 | :group 'languages) 48 | 49 | (defun elm-mode-after-save-handler () 50 | "Perform various operations upon saving a buffer." 51 | (when elm-sort-imports-on-save 52 | (elm-sort-imports)) 53 | (when elm-tags-on-save 54 | (elm-mode-generate-tags)) 55 | (when (or elm-sort-imports-on-save 56 | elm-tags-on-save) 57 | (let ((before-save-hook '()) 58 | (after-save-hook '())) 59 | (basic-save-buffer)))) 60 | 61 | (defvar elm-mode-map 62 | (let ((map (make-keymap))) 63 | (define-key map (kbd "C-c C-f") 'elm-format-buffer) 64 | (define-key map (kbd "C-c M-t") 'elm-mode-generate-tags) 65 | (define-key map (kbd "C-c C-l") 'elm-repl-load) 66 | (define-key map (kbd "C-c C-p") 'elm-repl-push) 67 | (define-key map (kbd "C-c C-e") 'elm-repl-push-decl) 68 | (define-key map (kbd "C-c C-z") 'elm-interactive) 69 | (define-key map (kbd "C-c C-a") 'elm-compile-add-annotations) 70 | (define-key map (kbd "C-c C-r") 'elm-compile-clean-imports) 71 | (define-key map (kbd "C-c C-c") 'elm-compile-buffer) 72 | (define-key map (kbd "C-c M-c") 'elm-compile-main) 73 | (define-key map (kbd "C-c M-k") 'elm-package-catalog) 74 | (define-key map (kbd "C-c C-n") 'elm-preview-buffer) 75 | (define-key map (kbd "C-c C-m") 'elm-preview-main) 76 | (define-key map (kbd "C-c C-d") 'elm-documentation-lookup) 77 | (define-key map (kbd "C-c C-i") 'elm-import) 78 | (define-key map (kbd "C-c C-s") 'elm-sort-imports) 79 | (define-key map (kbd "C-c C-v") 'elm-test-project) 80 | (easy-menu-define elm-mode-map map 81 | "Elm Mode Menu" 82 | '("Elm" 83 | ["Format Buffer" elm-format t] 84 | "--" 85 | ["Load Current File in REPL" elm-repl-load t] 86 | ["Push Region to REPL" elm-repl-push t] 87 | "--" 88 | ["Sort Imports" elm-sort-imports t] 89 | ["View Doc in Browser" elm-documentation-lookup t] 90 | "--" 91 | ["Generate TAGS" elm-mode-generate-tags t])) 92 | map) 93 | "Keymap for Elm major mode.") 94 | 95 | ;;;###autoload 96 | (defcustom elm-mode-hook '(elm-indent-mode) 97 | "Hook called by `elm-mode'." 98 | :type 'hook 99 | :group 'elm) 100 | 101 | ;;;###autoload 102 | (define-derived-mode elm-mode prog-mode "Elm" 103 | "Major mode for editing Elm source code." 104 | :group 'elm 105 | :syntax-table elm--syntax-table 106 | 107 | ;; Indentation 108 | ;; Elm is not generally suitable for electric indentation, since 109 | ;; there is no unambiguously correct indent level for any given 110 | ;; line. 111 | (when (boundp 'electric-indent-inhibit) (setq electric-indent-inhibit t)) 112 | 113 | (setq-local comment-start "--") 114 | (setq-local comment-end "") 115 | (setq-local imenu-create-index-function #'elm-imenu-create-index) 116 | (setq-local comment-start-skip "-- ") 117 | (setq-local indent-tabs-mode nil) 118 | 119 | (setq-local paragraph-start (concat " *{-\\| *-- |\\|" page-delimiter)) 120 | (setq-local paragraph-separate (concat " *$\\| *\\({-\\|-}\\) *$\\|" page-delimiter)) 121 | 122 | (setq-local beginning-of-defun-function #'elm-beginning-of-defun) 123 | (setq-local end-of-defun-function #'elm-end-of-defun) 124 | 125 | (when elm-format-on-save 126 | (elm-format-on-save-mode)) 127 | (add-hook 'after-save-hook #'elm-mode-after-save-handler nil t) 128 | (elm--font-lock-enable)) 129 | 130 | ;;;###autoload 131 | (add-to-list 'auto-mode-alist '("\\.elm\\'" . elm-mode)) 132 | 133 | (provide 'elm-mode) 134 | ;;; elm-mode.el ends here 135 | -------------------------------------------------------------------------------- /elm-tags.el: -------------------------------------------------------------------------------- 1 | ;;; elm-tags.el --- etags support for Elm. 2 | 3 | ;; Copyright (C) 2016 Bogdan Popa 4 | 5 | ;; Author: Bogdan Popa 6 | ;; URL: https://github.com/jcollard/elm-mode 7 | 8 | ;; This file is not part of GNU Emacs. 9 | 10 | ;; This file is free software; you can redistribute it and/or modify 11 | ;; it under the terms of the GNU General Public License as published by 12 | ;; the Free Software Foundation; either version 3, or (at your option) 13 | ;; any later version. 14 | 15 | ;; This file is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with this program. If not, see . 22 | 23 | ;;; Commentary: 24 | ;;; Code: 25 | (require 'elm-util) 26 | (require 'f) 27 | 28 | (defcustom elm-tags-on-save nil 29 | "Controls whether or not TAGS files should be generated on save." 30 | :group 'elm-tags 31 | :type 'boolean) 32 | 33 | (defcustom elm-tags-exclude-elm-stuff t 34 | "Whether to exclude the `elm-stuff' directory from the TAGS file." 35 | :group 'elm-tags 36 | :type 'boolean) 37 | 38 | (defconst elm-tags-regexps 39 | (f-join 40 | (f-dirname load-file-name) 41 | "elm.tags")) 42 | 43 | ;;;###autoload 44 | (defun elm-mode-generate-tags () 45 | "Generate a TAGS file for the current project." 46 | (interactive) 47 | (when (elm--has-dependency-file) 48 | (let* ((default-directory (elm--find-dependency-file-path)) 49 | (find-command "find . -type f -name \"*.elm\" -print") 50 | (exclude-command (if elm-tags-exclude-elm-stuff 51 | (concat find-command " | egrep -v elm-stuff") 52 | find-command)) 53 | (etags-command (concat 54 | exclude-command 55 | " | etags --language=none --regex=@" 56 | (shell-quote-argument elm-tags-regexps) 57 | " -"))) 58 | (call-process-shell-command (concat etags-command "&") nil 0)))) 59 | 60 | 61 | (provide 'elm-tags) 62 | ;;; elm-tags.el ends here 63 | -------------------------------------------------------------------------------- /elm-util.el: -------------------------------------------------------------------------------- 1 | ;;; elm-utils.el --- General utility functions used by Elm mode modules. 2 | 3 | ;; Copyright (C) 2013, 2014 Joseph Collard 4 | ;; Copyright (C) 2015 Bogdan Popa 5 | 6 | ;; Author: Joseph Collard 7 | ;; URL: https://github.com/jcollard/elm-mode 8 | 9 | ;; This file is not part of GNU Emacs. 10 | 11 | ;; This file is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation; either version 3, or (at your option) 14 | ;; any later version. 15 | 16 | ;; This file is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | ;;; Code: 26 | (require 'elm-defuns) 27 | (require 'f) 28 | (require 'json) 29 | (require 'let-alist) 30 | (require 's) 31 | (require 'pulse) 32 | 33 | (require 'haskell-decl-scan nil 'noerror) 34 | (require 'inf-haskell nil 'noerror) 35 | 36 | (defcustom elm-main-file "Main.elm" 37 | "Allows for a custom main file to be specified." 38 | :type 'string 39 | :group 'elm-util) 40 | 41 | (defcustom elm-flash-duration 0.40 42 | "Time in seconds for which declarations will be highlighted when applicable." 43 | :type 'number 44 | :group 'elm-util) 45 | 46 | (defcustom elm-package-json 47 | "elm.json" 48 | "The name of the package JSON configuration file." 49 | :type 'string 50 | :group 'elm-util) 51 | 52 | (when (require 'project nil t) 53 | (defun elm-project-find-function (dir) 54 | "Find a project for project.el looking upwards from DIR. 55 | This can be added to `project-find-functions' so that 56 | `project-root' will return the directory in which the 57 | `elm-package-json' file is found." 58 | (let ((root-dir (locate-dominating-file dir elm-package-json))) 59 | (when root-dir 60 | (cons 'elm root-dir)))) 61 | 62 | (cl-defmethod project-root ((project (head elm))) 63 | (cdr project))) 64 | 65 | (defun elm--get-module-name () 66 | "Return the qualified name of the module in the current buffer." 67 | (save-excursion 68 | (goto-char (point-min)) 69 | (unless (re-search-forward "module +\\([A-Z][A-Za-z0-9.]*\\)" nil t) 70 | (error "Module declaration not found")) 71 | (buffer-substring-no-properties (match-beginning 1) (match-end 1)))) 72 | 73 | (defun elm--get-decl () 74 | "Return the current declaration." 75 | (save-excursion 76 | (goto-char (1+ (point))) 77 | (unless (elm-beginning-of-defun) 78 | (user-error "Not in a declaration")) 79 | (let ((start (point))) 80 | (elm-end-of-defun) 81 | (let* ((end (point)) 82 | (raw-decl (s-trim-right (buffer-substring start end))) 83 | (lines (split-string raw-decl "\n")) 84 | (first-line (car lines)) 85 | ;; Shadow the defcustom pulse-delay variable. 86 | (pulse-delay (/ elm-flash-duration 10.0))) 87 | 88 | (pulse-momentary-highlight-region start end) 89 | (if (string-match-p "^[a-z].*:" first-line) 90 | (cdr lines) 91 | lines))))) 92 | 93 | (defun elm--build-import-statement () 94 | "Generate a statement that will import the current module." 95 | (concat "import " (elm--get-module-name) " exposing (..) \n")) 96 | 97 | (defun elm--get-buffer-dirname () 98 | "Return the absolute dirname of the current buffer." 99 | (file-name-as-directory default-directory)) 100 | 101 | (defun elm--buffer-local-file-name () 102 | "Return the current file name relative to the dependency file." 103 | (let ((dirname (buffer-file-name)) 104 | (deppath (elm--find-dependency-file-path))) 105 | (f-relative dirname deppath))) 106 | 107 | (defun elm--find-elm-test-root-directory () 108 | "Find the directory from which to run \"elm-test\". 109 | This is determined by looking for the closest parent directory 110 | which is not called \"tests\" and which contains a file named as 111 | per the `elm-package-json' variable." 112 | (or (locate-dominating-file 113 | default-directory 114 | (lambda (dir) 115 | (and (not (s-suffix-p "/tests/" dir)) 116 | (file-exists-p (expand-file-name elm-package-json dir))))) 117 | (error "No %s found in non-test parent directories" elm-package-json))) 118 | 119 | (defun elm--find-dependency-file-path () 120 | "Recursively search for a directory containing a package JSON file." 121 | (or (locate-dominating-file default-directory elm-package-json) 122 | (file-name-as-directory (f-dirname (buffer-file-name))))) 123 | 124 | (defun elm--has-dependency-file () 125 | "Check if a dependency file exists." 126 | (f-exists? (f-join (elm--find-dependency-file-path) elm-package-json))) 127 | 128 | (declare-function elm-create-package "elm-interactive.el" nil) 129 | (defun elm--assert-dependency-file () 130 | "Report an error unless there is a package file." 131 | (unless (elm--has-dependency-file) 132 | (if (yes-or-no-p "Elm package file not found. Create a new package?") 133 | (call-interactively #'elm-create-package) 134 | (error "Elm package file not found")))) 135 | 136 | (defun elm--read-dependency-file () 137 | "Find and read the JSON dependency file into an object." 138 | (elm--assert-dependency-file) 139 | (let ((dep-file (f-join (elm--find-dependency-file-path) elm-package-json))) 140 | (json-read-file dep-file))) 141 | 142 | (defun elm--find-main-file () 143 | "Find the main elm file." 144 | (let-alist (elm--read-dependency-file) 145 | (let ((source-dir (aref .source-directories 0))) 146 | (if (equal "." source-dir) 147 | elm-main-file 148 | (f-join source-dir elm-main-file))))) 149 | 150 | (defun elm--shell-and-command () 151 | "Determine the appropriate \"and\" command for the current shell. 152 | 153 | Currently only special cases the Fish shell, returning \"; and \" when 154 | Fish is used as the default system shell. Returns \" && \" in all other 155 | cases." 156 | ;; TODO: Windows? 157 | (let* ((shell (getenv "SHELL")) 158 | (executable (car (reverse (s-split "/" shell))))) 159 | (pcase executable 160 | ("fish" "; and ") 161 | (_ " && ")))) 162 | 163 | 164 | (provide 'elm-util) 165 | ;;; elm-util.el ends here 166 | -------------------------------------------------------------------------------- /elm.tags: -------------------------------------------------------------------------------- 1 | /^module +\([^ ]+\)/\1/ 2 | /^ +[=|] *\([A-Z][^ ]*\)/\1/ 3 | /^\(type +alias\|type\) +\([^ ]+\)/\2/ 4 | /^\((\([^)]+\))\|[^ ]+\).*=/\1/ --------------------------------------------------------------------------------