From 0172b10b8b0f352fdc45757abfe7fdf2a4d03960 Mon Sep 17 00:00:00 2001 From: Daniel <89086143+BardofSprites@users.noreply.github.com> Date: Sat, 20 Apr 2024 11:19:15 -0400 Subject: rename old-ada dir --- old-ada/LICENSE | 674 ++++++ old-ada/README.rst | 39 + old-ada/ada-mode.el | 5494 +++++++++++++++++++++++++++++++++++++++++++ old-ada/ada-prj.el | 682 ++++++ old-ada/ada-stmt.el | 486 ++++ old-ada/ada-xref.el | 2359 +++++++++++++++++++ old-ada/doc/ada-mode.html | 2288 ++++++++++++++++++ old-ada/doc/ada-mode.info | 1983 ++++++++++++++++ old-ada/doc/ada-mode.pdf | Bin 0 -> 303898 bytes old-ada/doc/ada-mode.texi | 1526 ++++++++++++ old-ada/doc/build.sh | 3 + old-ada/doc/clean.sh | 2 + old-ada/doc/doclicense.texi | 505 ++++ old-ada/doc/docstyle.texi | 19 + old_ada/LICENSE | 674 ------ old_ada/README.rst | 39 - old_ada/ada-mode.el | 5494 ------------------------------------------- old_ada/ada-prj.el | 682 ------ old_ada/ada-stmt.el | 486 ---- old_ada/ada-xref.el | 2359 ------------------- old_ada/doc/ada-mode.html | 2288 ------------------ old_ada/doc/ada-mode.info | 1983 ---------------- old_ada/doc/ada-mode.pdf | Bin 303898 -> 0 bytes old_ada/doc/ada-mode.texi | 1526 ------------ old_ada/doc/build.sh | 3 - old_ada/doc/clean.sh | 2 - old_ada/doc/doclicense.texi | 505 ---- old_ada/doc/docstyle.texi | 19 - 28 files changed, 16060 insertions(+), 16060 deletions(-) create mode 100644 old-ada/LICENSE create mode 100644 old-ada/README.rst create mode 100644 old-ada/ada-mode.el create mode 100644 old-ada/ada-prj.el create mode 100644 old-ada/ada-stmt.el create mode 100644 old-ada/ada-xref.el create mode 100644 old-ada/doc/ada-mode.html create mode 100644 old-ada/doc/ada-mode.info create mode 100644 old-ada/doc/ada-mode.pdf create mode 100644 old-ada/doc/ada-mode.texi create mode 100755 old-ada/doc/build.sh create mode 100755 old-ada/doc/clean.sh create mode 100644 old-ada/doc/doclicense.texi create mode 100644 old-ada/doc/docstyle.texi delete mode 100644 old_ada/LICENSE delete mode 100644 old_ada/README.rst delete mode 100644 old_ada/ada-mode.el delete mode 100644 old_ada/ada-prj.el delete mode 100644 old_ada/ada-stmt.el delete mode 100644 old_ada/ada-xref.el delete mode 100644 old_ada/doc/ada-mode.html delete mode 100644 old_ada/doc/ada-mode.info delete mode 100644 old_ada/doc/ada-mode.pdf delete mode 100644 old_ada/doc/ada-mode.texi delete mode 100755 old_ada/doc/build.sh delete mode 100755 old_ada/doc/clean.sh delete mode 100644 old_ada/doc/doclicense.texi delete mode 100644 old_ada/doc/docstyle.texi diff --git a/old-ada/LICENSE b/old-ada/LICENSE new file mode 100644 index 0000000..f288702 --- /dev/null +++ b/old-ada/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/old-ada/README.rst b/old-ada/README.rst new file mode 100644 index 0000000..ec54e47 --- /dev/null +++ b/old-ada/README.rst @@ -0,0 +1,39 @@ +Old ada-mode.el +=============== + +This is a fork of the old version of ``ada-mode.el`` that was +distributed with Emacs. + +I was unable to get the newer packaged version of ``ada-mode.el``, +which uses an external program for indentation, fontification, and +navigation, to work after trying on several operating systems. + +However, the old version worked fine for me. + +So I dug it out of the `Emacs git repository`_ at `savannah.gnu.org`_. +Basically, I cloned the git repository and then figured out what +commit it was deleted in by doing:: + + $ git rev-list HEAD -n 1 -- lisp/progmodes/ada-mode.el + a13c64204c8ead966789abf8efe176e4f2d4f599 + +Then I checked out the files involved:: + + $ git checkout a13c64204c8ead966789abf8efe176e4f2d4f599^ lisp/progmodes/ada-mode.el lisp/progmodes/ada-prj.el lisp/progmodes/ada-stmt.el lisp/progmodes/ada-xref.el doc/misc/ada-mode.texi doc/docstyle.texi doc/doclicense.texi + +The ``^`` at the end of the commit hash says to get the previous +commit. + +This formed the initial checking for this repository. + +It turns out that Emacs 28 doesn't automatically add ada files to +``auto-mode-alist`` (see `issue #2`_). So, do the following: + +.. _issue #2: https://github.com/tkurtbond/old-ada-mode/issues/2 + +.. code:: emacs-lisp + + (cl-loop for ext in '("\\.gpr$" "\\.ada$" "\\.ads$" "\\.adb$") + do (add-to-list 'auto-mode-alist (cons ext 'ada-mode))) + + diff --git a/old-ada/ada-mode.el b/old-ada/ada-mode.el new file mode 100644 index 0000000..b7f0535 --- /dev/null +++ b/old-ada/ada-mode.el @@ -0,0 +1,5494 @@ +;;; ada-mode.el --- major-mode for editing Ada sources + +;; Copyright (C) 1994-1995, 1997-2019 Free Software Foundation, Inc. + +;; Author: Rolf Ebert +;; Markus Heritsch +;; Emmanuel Briot +;; Maintainer: Stephen Leake +;; Keywords: languages ada +;; Version: 4.0 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; This mode is a major mode for editing Ada code. This is a major +;; rewrite of the file packaged with Emacs-20. The Ada mode is +;; composed of four Lisp files: ada-mode.el, ada-xref.el, ada-prj.el +;; and ada-stmt.el. Only this file (ada-mode.el) is completely +;; independent from the GNU Ada compiler GNAT, distributed by Ada +;; Core Technologies. All the other files rely heavily on features +;; provided only by GNAT. + +;;; Usage: +;; Emacs should enter Ada mode automatically when you load an Ada file. +;; By default, the valid extensions for Ada files are .ads, .adb or .ada +;; If the ada-mode does not start automatically, then simply type the +;; following command : +;; M-x ada-mode +;; +;; By default, ada-mode is configured to take full advantage of the GNAT +;; compiler (the menus will include the cross-referencing features,...). +;; If you are using another compiler, you might want to set the following +;; variable in your .emacs (Note: do not set this in the ada-mode-hook, it +;; won't work) : +;; (setq ada-which-compiler 'generic) +;; +;; This mode requires find-file.el to be present on your system. + +;;; History: +;; The first Ada mode for GNU Emacs was written by V. Broman in +;; 1985. He based his work on the already existing Modula-2 mode. +;; This was distributed as ada.el in versions of Emacs prior to 19.29. +;; +;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of +;; several files with support for dired commands and other nice +;; things. It is currently available from the PAL +;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z. +;; +;; The probably very first Ada mode (called electric-ada.el) was +;; written by Steven D. Litvintchouk and Steven M. Rosen for the +;; Gosling Emacs. L. Slater based his development on ada.el and +;; electric-ada.el. +;; +;; A complete rewrite by M. Heritsch and R. Ebert has been done. +;; Some ideas from the Ada mode mailing list have been +;; added. Some of the functionality of L. Slater's mode has not +;; (yet) been recoded in this new mode. Perhaps you prefer sticking +;; to his version. +;; +;; A complete rewrite for Emacs-20 / GNAT-3.11 has been done by Ada Core +;; Technologies. + +;;; Credits: +;; Many thanks to John McCabe for sending so +;; many patches included in this package. +;; Christian Egli : +;; ada-imenu-generic-expression +;; Many thanks also to the following persons that have contributed +;; to the ada-mode +;; Philippe Waroquiers (PW) in particular, +;; woodruff@stc.llnl.gov (John Woodruff) +;; jj@ddci.dk (Jesper Joergensen) +;; gse@ocsystems.com (Scott Evans) +;; comar@gnat.com (Cyrille Comar) +;; stephen.leake@gsfc.nasa.gov (Stephen Leake) +;; robin-reply@reagans.org +;; and others for their valuable hints. + +;;; Code: +;; Note: Every function in this package is compiler-independent. +;; The names start with ada- +;; The variables that the user can edit can all be modified through +;; the customize mode. They are sorted in alphabetical order in this +;; file. + +;; Supported packages. +;; This package supports a number of other Emacs modes. These other modes +;; should be loaded before the ada-mode, which will then setup some variables +;; to improve the support for Ada code. +;; Here is the list of these modes: +;; `which-function-mode': Display in the mode line the name of the subprogram +;; the cursor is in. +;; `outline-mode': Provides the capability to collapse or expand the code +;; for specific language constructs, for instance if you want to hide the +;; code corresponding to a subprogram +;; `align': This mode is now provided with Emacs 21, but can also be +;; installed manually for older versions of Emacs. It provides the +;; capability to automatically realign the selected region (for instance +;; all ':=', ':' and '--' will be aligned on top of each other. +;; `imenu': Provides a menu with the list of entities defined in the current +;; buffer, and an easy way to jump to any of them +;; `speedbar': Provides a separate file browser, and the capability for each +;; file to see the list of entities defined in it and to jump to them +;; easily +;; `abbrev-mode': Provides the capability to define abbreviations, which +;; are automatically expanded when you type them. See the Emacs manual. + +(require 'find-file nil t) +(require 'align nil t) +(require 'which-func nil t) +(require 'compile nil t) + +(defvar ispell-check-comments) +(defvar skeleton-further-elements) + +(define-error 'ada-mode-errors nil) + +(defun ada-mode-version () + "Return Ada mode version." + (interactive) + (let ((version-string "4.00")) + (if (called-interactively-p 'interactive) + (message version-string) + version-string))) + +(defvar ada-mode-hook nil + "List of functions to call when Ada mode is invoked. +This hook is automatically executed after the `ada-mode' is +fully loaded. +This is a good place to add Ada environment specific bindings.") + +(defgroup ada nil + "Major mode for editing and compiling Ada source in Emacs." + :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) + :link '(custom-manual "(ada-mode) Top") + :link '(emacs-commentary-link :tag "Commentary" "ada-mode.el") + :group 'languages) + +(defcustom ada-auto-case t + "Non-nil means automatically change case of preceding word while typing. +Casing is done according to `ada-case-keyword', `ada-case-identifier' +and `ada-case-attribute'." + :type 'boolean :group 'ada) + +(defcustom ada-broken-decl-indent 0 + "Number of columns to indent a broken declaration. + +An example is : + declare + A, + >>>>>B : Integer;" + :type 'integer :group 'ada) + +(defcustom ada-broken-indent 2 + "Number of columns to indent the continuation of a broken line. + +An example is : + My_Var : My_Type := (Field1 => + >>>>>>>>>Value);" + :type 'integer :group 'ada) + +(defcustom ada-continuation-indent ada-broken-indent + "Number of columns to indent the continuation of broken lines in parenthesis. + +An example is : + Func (Param1, + >>>>>Param2);" + :type 'integer :group 'ada) + +(defcustom ada-case-attribute 'ada-capitalize-word + "Function to call to adjust the case of Ada attributes. +It may be `downcase-word', `upcase-word', `ada-loose-case-word', +`ada-capitalize-word' or `ada-no-auto-case'." + :type '(choice (const downcase-word) + (const upcase-word) + (const ada-capitalize-word) + (const ada-loose-case-word) + (const ada-no-auto-case)) + :group 'ada) + +(defcustom ada-case-exception-file + (list (convert-standard-filename' "~/.emacs_case_exceptions")) + "List of special casing exceptions dictionaries for identifiers. +The first file is the one where new exceptions will be saved by Emacs +when you call `ada-create-case-exception'. + +These files should contain one word per line, that gives the casing +to be used for that word in Ada files. If the line starts with the +character *, then the exception will be used for substrings that either +start at the beginning of a word or after a _ character, and end either +at the end of the word or at a _ character. Each line can be terminated +by a comment." + :type '(repeat (file)) + :group 'ada) + +(defcustom ada-case-keyword 'downcase-word + "Function to call to adjust the case of an Ada keywords. +It may be `downcase-word', `upcase-word', `ada-loose-case-word' or +`ada-capitalize-word'." + :type '(choice (const downcase-word) + (const upcase-word) + (const ada-capitalize-word) + (const ada-loose-case-word) + (const ada-no-auto-case)) + :group 'ada) + +(defcustom ada-case-identifier 'ada-loose-case-word + "Function to call to adjust the case of an Ada identifier. +It may be `downcase-word', `upcase-word', `ada-loose-case-word' or +`ada-capitalize-word'." + :type '(choice (const downcase-word) + (const upcase-word) + (const ada-capitalize-word) + (const ada-loose-case-word) + (const ada-no-auto-case)) + :group 'ada) + +(defcustom ada-clean-buffer-before-saving t + "Non-nil means remove trailing spaces and untabify the buffer before saving." + :type 'boolean :group 'ada) +(make-obsolete-variable 'ada-clean-buffer-before-saving + "it has no effect - use `write-file-functions' hook." + "23.2") + + +(defcustom ada-indent 3 + "Size of Ada indentation. + +An example is : +procedure Foo is +begin +>>>>>>>>>>null;" + :type 'integer :group 'ada) + +(defcustom ada-indent-after-return t + "Non-nil means automatically indent after RET or LFD." + :type 'boolean :group 'ada) + +(defcustom ada-indent-align-comments t + "Non-nil means align comments on previous line comments, if any. +If nil, indentation is calculated as usual. +Note that indentation is calculated only if `ada-indent-comment-as-code' is t. + +For instance: + A := 1; -- A multi-line comment + -- aligned if `ada-indent-align-comments' is t" + :type 'boolean :group 'ada) + +(defcustom ada-indent-comment-as-code t + "Non-nil means indent comment lines as code. +A nil value means do not auto-indent comments." + :type 'boolean :group 'ada) + +(defcustom ada-indent-handle-comment-special nil + "Non-nil if comment lines should be handled specially inside parenthesis. +By default, if the line that contains the open parenthesis has some +text following it, then the following lines will be indented in the +same column as this text. This will not be true if the first line is +a comment and `ada-indent-handle-comment-special' is t. + +type A is + ( Value_1, -- common behavior, when not a comment + Value_2); + +type A is + ( -- `ada-indent-handle-comment-special' is nil + Value_1, + Value_2); + +type A is + ( -- `ada-indent-handle-comment-special' is non-nil + Value_1, + Value_2);" + :type 'boolean :group 'ada) + +(defcustom ada-indent-is-separate t + "Non-nil means indent `is separate' or `is abstract' if on a single line." + :type 'boolean :group 'ada) + +(defcustom ada-indent-record-rel-type 3 + "Indentation for `record' relative to `type' or `use'. + +An example is: + type A is + >>>>>>>>>>>record" + :type 'integer :group 'ada) + +(defcustom ada-indent-renames ada-broken-indent + "Indentation for renames relative to the matching function statement. +If `ada-indent-return' is null or negative, the indentation is done relative to +the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used). + +An example is: + function A (B : Integer) + return C; + >>>renames Foo;" + :type 'integer :group 'ada) + +(defcustom ada-indent-return 0 + "Indentation for `return' relative to the matching `function' statement. +If `ada-indent-return' is null or negative, the indentation is done relative to +the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used). + +An example is: + function A (B : Integer) + >>>>>return C;" + :type 'integer :group 'ada) + +(defcustom ada-indent-to-open-paren t + "Non-nil means indent according to the innermost open parenthesis." + :type 'boolean :group 'ada) + +(defcustom ada-fill-comment-prefix "-- " + "Text inserted in the first columns when filling a comment paragraph. +Note: if you modify this variable, you will have to invoke `ada-mode' +again to take account of the new value." + :type 'string :group 'ada) + +(defcustom ada-fill-comment-postfix " --" + "Text inserted at the end of each line when filling a comment paragraph. +Used by `ada-fill-comment-paragraph-postfix'." + :type 'string :group 'ada) + +(defcustom ada-label-indent -4 + "Number of columns to indent a label. + +An example is: +procedure Foo is +begin +>>>>Label: + +This is also used for <<..>> labels" + :type 'integer :group 'ada) + +(defcustom ada-language-version 'ada95 + "Ada language version; one of `ada83', `ada95', `ada2005'." + :type '(choice (const ada83) (const ada95) (const ada2005)) :group 'ada) + +(defcustom ada-move-to-declaration nil + "Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to `begin'." + :type 'boolean :group 'ada) + +(defcustom ada-popup-key '[down-mouse-3] + "Key used for binding the contextual menu. +If nil, no contextual menu is available." + :type '(restricted-sexp :match-alternatives (stringp vectorp)) + :group 'ada) + +(defcustom ada-search-directories + (append '(".") + (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":") + '("/usr/adainclude" "/usr/local/adainclude" + "/opt/gnu/adainclude")) + "Default list of directories to search for Ada files. +See the description for the `ff-search-directories' variable. This variable +is the initial value of `ada-search-directories-internal'." + :type '(repeat (choice :tag "Directory" + (const :tag "default" nil) + (directory :format "%v"))) + :group 'ada) + +(defvar ada-search-directories-internal ada-search-directories + "Internal version of `ada-search-directories'. +Its value is the concatenation of the search path as read in the project file +and the standard runtime location, and the value of the user-defined +`ada-search-directories'.") + +(defcustom ada-stmt-end-indent 0 + "Number of columns to indent the end of a statement on a separate line. + +An example is: + if A = B + >>>>then" + :type 'integer :group 'ada) + +(defcustom ada-tab-policy 'indent-auto + "Control the behavior of the TAB key. +Must be one of : +`indent-rigidly' : always adds `ada-indent' blanks at the beginning of the line. +`indent-auto' : use indentation functions in this file. +`always-tab' : do `indent-relative'." + :type '(choice (const indent-auto) + (const indent-rigidly) + (const always-tab)) + :group 'ada) + +(defcustom ada-use-indent ada-broken-indent + "Indentation for the lines in a `use' statement. + +An example is: + use Ada.Text_IO, + >>>>Ada.Numerics;" + :type 'integer :group 'ada) + +(defcustom ada-when-indent 3 + "Indentation for `when' relative to `exception' or `case'. + +An example is: + case A is + >>>>when B =>" + :type 'integer :group 'ada) + +(defcustom ada-with-indent ada-broken-indent + "Indentation for the lines in a `with' statement. + +An example is: + with Ada.Text_IO, + >>>>Ada.Numerics;" + :type 'integer :group 'ada) + +(defcustom ada-which-compiler 'gnat + "Name of the compiler to use. +This will determine what features are made available through the Ada mode. +The possible choices are: +`gnat': Use Ada Core Technologies' GNAT compiler. Add some cross-referencing + features. +`generic': Use a generic compiler." + :type '(choice (const gnat) + (const generic)) + :group 'ada) + + +;;; ---- end of user configurable variables + + +(defvar ada-body-suffixes '(".adb") + "List of possible suffixes for Ada body files. +The extensions should include a `.' if needed.") + +(defvar ada-spec-suffixes '(".ads") + "List of possible suffixes for Ada spec files. +The extensions should include a `.' if needed.") + +(defvar ada-mode-menu (make-sparse-keymap "Ada") + "Menu for Ada mode.") + +(defvar ada-mode-map (make-sparse-keymap) + "Local keymap used for Ada mode.") + +(defvar ada-mode-extra-map (make-sparse-keymap) + "Keymap used for non-standard keybindings.") + +;; default is C-c C-q because it's free in ada-mode-map +(defvar ada-mode-extra-prefix "\C-c\C-q" + "Prefix key to access `ada-mode-extra-map' functions.") + +(define-abbrev-table 'ada-mode-abbrev-table () + "Local abbrev table for Ada mode.") + +(eval-when-compile + ;; These values are used in eval-when-compile expressions. + (defconst ada-83-string-keywords + '("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin" + "body" "case" "constant" "declare" "delay" "delta" "digits" "do" + "else" "elsif" "end" "entry" "exception" "exit" "for" "function" + "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new" + "not" "null" "of" "or" "others" "out" "package" "pragma" "private" + "procedure" "raise" "range" "record" "rem" "renames" "return" + "reverse" "select" "separate" "subtype" "task" "terminate" "then" + "type" "use" "when" "while" "with" "xor") + "List of Ada 83 keywords. +Used to define `ada-*-keywords'.") + + (defconst ada-95-string-keywords + '("abstract" "aliased" "protected" "requeue" "tagged" "until") + "List of keywords new in Ada 95. +Used to define `ada-*-keywords'.") + + (defconst ada-2005-string-keywords + '("interface" "overriding" "synchronized") + "List of keywords new in Ada 2005. +Used to define `ada-*-keywords.'")) + +(defvar ada-ret-binding nil + "Variable to save key binding of RET when casing is activated.") + +(defvar ada-case-exception '() + "Alist of words (entities) that have special casing.") + +(defvar ada-case-exception-substring '() + "Alist of substrings (entities) that have special casing. +The substrings are detected for word constituent when the word +is not itself in `ada-case-exception', and only for substrings that +either are at the beginning or end of the word, or start after `_'.") + +(defvar ada-lfd-binding nil + "Variable to save key binding of LFD when casing is activated.") + +(defvar ada-other-file-alist nil + "Variable used by `find-file' to find the name of the other package. +See `ff-other-file-alist'.") + +(defvar ada-align-list + '(("[^:]\\(\\s-*\\):[^:]" 1 t) + ("[^=]\\(\\s-+\\)=[^=]" 1 t) + ("\\(\\s-*\\)use\\s-" 1) + ("\\(\\s-*\\)--" 1)) + "Ada support for align.el <= 2.2. +This variable provides regular expressions on which to align different lines. +See `align-mode-alist' for more information.") + +(defvar ada-align-modes + '((ada-declaration + (regexp . "[^:]\\(\\s-*\\):[^:]") + (valid . (lambda() (not (ada-in-comment-p)))) + (modes . '(ada-mode))) + (ada-assignment + (regexp . "[^=]\\(\\s-+\\)=[^=]") + (valid . (lambda() (not (ada-in-comment-p)))) + (modes . '(ada-mode))) + (ada-comment + (regexp . "\\(\\s-*\\)--") + (modes . '(ada-mode))) + (ada-use + (regexp . "\\(\\s-*\\)use\\s-") + (valid . (lambda() (not (ada-in-comment-p)))) + (modes . '(ada-mode))) + ) + "Ada support for align.el >= 2.8. +This variable defines several rules to use to align different lines.") + +(defconst ada-align-region-separate + (eval-when-compile + (concat + "^\\s-*\\($\\|\\(" + "begin\\|" + "declare\\|" + "else\\|" + "end\\|" + "exception\\|" + "for\\|" + "function\\|" + "generic\\|" + "if\\|" + "is\\|" + "procedure\\|" + "record\\|" + "return\\|" + "type\\|" + "when" + "\\)\\>\\)")) + "See the variable `align-region-separate' for more information.") + +;;; ---- Below are the regexp used in this package for parsing + +(defconst ada-83-keywords + (eval-when-compile + (concat "\\<" (regexp-opt ada-83-string-keywords t) "\\>")) + "Regular expression matching Ada83 keywords.") + +(defconst ada-95-keywords + (eval-when-compile + (concat "\\<" (regexp-opt + (append + ada-95-string-keywords + ada-83-string-keywords) t) "\\>")) + "Regular expression matching Ada95 keywords.") + +(defconst ada-2005-keywords + (eval-when-compile + (concat "\\<" (regexp-opt + (append + ada-2005-string-keywords + ada-83-string-keywords + ada-95-string-keywords) t) "\\>")) + "Regular expression matching Ada2005 keywords.") + +(defvar ada-keywords ada-2005-keywords + "Regular expression matching Ada keywords.") +;; FIXME: make this customizable + +(defconst ada-ident-re + "[[:alpha:]]\\(?:[_[:alnum:]]\\)*" + ;; [:alnum:] matches any multibyte word constituent, as well as + ;; Latin-1 letters and numbers. This allows __ and trailing _; + ;; someone (emacs bug#1919) proposed [^\W_] to fix that, but \W does + ;; _not_ mean "not word constituent" inside a character alternative. + "Regexp matching an Ada identifier.") + +(defconst ada-goto-label-re + (concat "<<" ada-ident-re ">>") + "Regexp matching a goto label.") + +(defconst ada-block-label-re + (concat ada-ident-re "[ \t\n]*:[^=]") + "Regexp matching a block label. +Note that this also matches a variable declaration.") + +(defconst ada-label-re + (concat "\\(?:" ada-block-label-re "\\)\\|\\(?:" ada-goto-label-re "\\)") + "Regexp matching a goto or block label.") + +;; "with" needs to be included in the regexp, to match generic subprogram parameters +;; Similarly, we put '[not] overriding' on the same line with 'procedure' etc. +(defvar ada-procedure-start-regexp + (concat + "^[ \t]*\\(with[ \t]+\\)?\\(\\(not[ \t]+\\)?overriding[ \t]+\\)?\\(procedure\\|function\\|task\\)[ \t\n]+" + + ;; subprogram name: operator ("[+/=*]") + "\\(" + "\\(\"[^\"]+\"\\)" + + ;; subprogram name: name + "\\|" + "\\(\\(\\sw\\|[_.]\\)+\\)" + "\\)") + "Regexp matching Ada subprogram start. +The actual start is at (match-beginning 4). The name is in (match-string 5).") + +(defconst ada-name-regexp + "\\([a-zA-Z][a-zA-Z0-9_.']*[a-zA-Z0-9]\\)" + "Regexp matching a fully qualified name (including attribute).") + +(defconst ada-package-start-regexp + (concat "^[ \t]*\\(private[ \t]+\\)?\\(package\\)[ \t\n]+\\(body[ \t]*\\)?" ada-name-regexp) + "Regexp matching start of package. +The package name is in (match-string 4).") + +(defconst ada-compile-goto-error-file-linenr-re + "\\([-_.a-zA-Z0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?" + "Regexp matching filename:linenr[:column].") + + +;;; ---- regexps for indentation functions + +(defvar ada-block-start-re + (eval-when-compile + (concat "\\<\\(" (regexp-opt '("begin" "declare" "else" + "exception" "generic" "loop" "or" + "private" "select" )) + "\\|\\(\\(limited\\|abstract\\|tagged\\)[ \t\n]+\\)*record\\)\\>")) + "Regexp for keywords starting Ada blocks.") + +(defvar ada-end-stmt-re + (eval-when-compile + (concat "\\(" + ";" "\\|" + "=>[ \t]*$" "\\|" + "=>[ \t]*--.*$" "\\|" + "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)" "\\|" + "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic" + "loop" "private" "record" "select" + "then abort" "then") t) "\\>" "\\|" + "^[ \t]*" (regexp-opt '("function" "package" "procedure") + t) "\\>\\(\\sw\\|[ \t_.]\\)+\\" "\\|" + "^[ \t]*exception\\>" + "\\)") ) + "Regexp of possible ends for a non-broken statement. +A new statement starts after these.") + +(defvar ada-matching-start-re + (eval-when-compile + (concat "\\<" + (regexp-opt + '("end" "loop" "select" "begin" "case" "do" "declare" + "if" "task" "package" "procedure" "function" "record" "protected") t) + "\\>")) + "Regexp used in `ada-goto-matching-start'.") + +(defvar ada-loop-start-re + "\\<\\(for\\|while\\|loop\\)\\>" + "Regexp for the start of a loop.") + +(defvar ada-subprog-start-re + (eval-when-compile + (concat "\\<" (regexp-opt '("accept" "entry" "function" "overriding" "package" "procedure" + "protected" "task") t) "\\>")) + "Regexp for the start of a subprogram.") + +(defvar ada-contextual-menu-on-identifier nil + "Set to true when the right mouse button was clicked on an identifier.") + +(defvar ada-contextual-menu-last-point nil + "Position of point just before displaying the menu. +This is a list (point buffer). +Since `ada-popup-menu' moves the point where the user clicked, the region +is modified. Therefore no command from the menu knows what the user selected +before displaying the contextual menu. +To get the original region, restore the point to this position before +calling `region-end' and `region-beginning'. +Modify this variable if you want to restore the point to another position.") + +(easy-menu-define ada-contextual-menu nil + "Menu to use when the user presses the right mouse button. +The variable `ada-contextual-menu-on-identifier' will be set to t before +displaying the menu if point was on an identifier." + '("Ada" + ["Goto Declaration/Body" ada-point-and-xref + :included ada-contextual-menu-on-identifier] + ["Goto Body" ada-point-and-xref-body + :included ada-contextual-menu-on-identifier] + ["Goto Previous Reference" ada-xref-goto-previous-reference] + ["List References" ada-find-references + :included ada-contextual-menu-on-identifier] + ["List Local References" ada-find-local-references + :included ada-contextual-menu-on-identifier] + ["-" nil nil] + ["Other File" ff-find-other-file] + ["Goto Parent Unit" ada-goto-parent])) + + +;;------------------------------------------------------------------ +;; Support for imenu (see imenu.el) +;;------------------------------------------------------------------ + +(defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?") + +(defconst ada-imenu-subprogram-menu-re + (concat "^[ \t]*\\(overriding[ \t]*\\)?\\(procedure\\|function\\)[ \t\n]+" + "\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)" + ada-imenu-comment-re + "\\)[ \t\n]*" + "\\(return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?is[ \t\n]")) + +(defvar ada-imenu-generic-expression + (list + (list nil ada-imenu-subprogram-menu-re 3) + (list "*Specs*" + (concat + "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)" + "\\(" + "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)" + ada-imenu-comment-re "\\)";; parameter list or simple space + "\\([ \t\n]*return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?" + "\\)?;") 2) + '("*Tasks*" "^[ \t]*task[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2) + '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2) + '("*Protected*" + "^[ \t]*protected[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2) + '("*Packages*" "^[ \t]*package[ \t]+\\(\\(body[ \t]+\\)?\\(\\sw\\|[_.]\\)+\\)" 1)) + "Imenu generic expression for Ada mode. +See `imenu-generic-expression'. This variable will create several submenus for +each type of entity that can be found in an Ada file.") + + +;;------------------------------------------------------------ +;; Support for compile.el +;;------------------------------------------------------------ + +(defun ada-compile-mouse-goto-error () + "Mouse interface for `ada-compile-goto-error'." + (interactive) + (mouse-set-point last-input-event) + (ada-compile-goto-error (point)) + ) + +(defun ada-compile-goto-error (pos) + "Replace `compile-goto-error' from compile.el. +If POS is on a file and line location, go to this position. It adds +to compile.el the capacity to go to a reference in an error message. +For instance, on these lines: + foo.adb:61:11: [...] in call to size declared at foo.ads:11 + foo.adb:61:11: [...] in call to local declared at line 20 +the 4 file locations can be clicked on and jumped to." + (interactive "d") + (goto-char pos) + + (skip-chars-backward "-a-zA-Z0-9_:./\\\\") + (cond + ;; special case: looking at a filename:line not at the beginning of a line + ;; or a simple line reference "at line ..." + ((and (not (bolp)) + (or (looking-at ada-compile-goto-error-file-linenr-re) + (and + (save-excursion + (beginning-of-line) + (looking-at ada-compile-goto-error-file-linenr-re)) + (save-excursion + (if (looking-at "\\([0-9]+\\)") (backward-word-strictly 1)) + (looking-at "line \\([0-9]+\\)")))) + ) + (let ((line (if (match-beginning 2) (match-string 2) (match-string 1))) + (file (if (match-beginning 2) (match-string 1) + (save-excursion (beginning-of-line) + (looking-at ada-compile-goto-error-file-linenr-re) + (match-string 1)))) + (error-pos (point-marker)) + source) + + ;; set source marker + (save-excursion + (compilation-find-file (point-marker) (match-string 1) "./") + (set-buffer file) + + (when (stringp line) + (goto-char (point-min)) + (forward-line (1- (string-to-number line)))) + + (setq source (point-marker))) + + (compilation-goto-locus error-pos source nil) + + )) + + ;; otherwise, default behavior + (t + (compile-goto-error)) + ) + (recenter)) + + +;;------------------------------------------------------------------------- +;; Grammar related function +;; The functions below work with the syntax class of the characters in an Ada +;; buffer. Two syntax tables are created, depending on whether we want '_' +;; to be considered as part of a word or not. +;; Some characters may have multiple meanings depending on the context: +;; - ' is either the beginning of a constant character or an attribute +;; - # is either part of a based literal or a gnatprep statement. +;; - " starts a string, but not if inside a constant character. +;; - ( and ) should be ignored if inside a constant character. +;; Thus their syntax property is changed automatically, and we can still use +;; the standard Emacs functions for sexp (see `ada-in-string-p') +;; +;; On Emacs, this is done through the `syntax-table' text property. The +;; corresponding action is applied automatically each time the buffer +;; changes via syntax-propertize-function. +;; +;; on XEmacs, the `syntax-table' property does not exist and we have to use a +;; slow advice to `parse-partial-sexp' to do the same thing. +;; When executing parse-partial-sexp, we simply modify the strings before and +;; after, so that the special constants '"', '(' and ')' do not interact +;; with parse-partial-sexp. +;; Note: this code is slow and needs to be rewritten as soon as something +;; better is available on XEmacs. +;;------------------------------------------------------------------------- + +(defvar ada-mode-syntax-table + (let ((st (make-syntax-table))) + ;; Define string brackets (`%' is alternative string bracket, but + ;; almost never used as such and throws font-lock and indentation + ;; off the track.) + (modify-syntax-entry ?% "$" st) + (modify-syntax-entry ?\" "\"" st) + + (modify-syntax-entry ?: "." st) + (modify-syntax-entry ?\; "." st) + (modify-syntax-entry ?& "." st) + (modify-syntax-entry ?\| "." st) + (modify-syntax-entry ?+ "." st) + (modify-syntax-entry ?* "." st) + (modify-syntax-entry ?/ "." st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?< "." st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?$ "." st) + (modify-syntax-entry ?\[ "." st) + (modify-syntax-entry ?\] "." st) + (modify-syntax-entry ?\{ "." st) + (modify-syntax-entry ?\} "." st) + (modify-syntax-entry ?. "." st) + (modify-syntax-entry ?\\ "." st) + (modify-syntax-entry ?\' "." st) + + ;; A single hyphen is punctuation, but a double hyphen starts a comment. + (modify-syntax-entry ?- ". 12" st) + + ;; See the comment above on grammar related function for the special + ;; setup for '#'. + (modify-syntax-entry ?# (if (featurep 'xemacs) "<" "$") st) + + ;; And \f and \n end a comment. + (modify-syntax-entry ?\f "> " st) + (modify-syntax-entry ?\n "> " st) + + ;; Define what belongs in Ada symbols. + (modify-syntax-entry ?_ "_" st) + + ;; Define parentheses to match. + (modify-syntax-entry ?\( "()" st) + (modify-syntax-entry ?\) ")(" st) + st) + "Syntax table to be used for editing Ada source code.") + +(defvar ada-mode-symbol-syntax-table + (let ((st (make-syntax-table ada-mode-syntax-table))) + (modify-syntax-entry ?_ "w" st) + st) + "Syntax table for Ada, where `_' is a word constituent.") + +;; Support of special characters in XEmacs (see the comments at the beginning +;; of the section on Grammar related functions). + +(if (featurep 'xemacs) + (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants) + "Handles special character constants and gnatprep statements." + (let (change) + (if (< to from) + (let ((tmp from)) + (setq from to to tmp))) + (save-excursion + (goto-char from) + (while (re-search-forward "'\\([(\")#]\\)'" to t) + (setq change (cons (list (match-beginning 1) + 1 + (match-string 1)) + change)) + (replace-match "'A'")) + (goto-char from) + (while (re-search-forward "\\(#[[:xdigit:]]*#\\)" to t) + (setq change (cons (list (match-beginning 1) + (length (match-string 1)) + (match-string 1)) + change)) + (replace-match (make-string (length (match-string 1)) ?@)))) + ad-do-it + (save-excursion + (while change + (goto-char (caar change)) + (delete-char (cadar change)) + (insert (caddar change)) + (setq change (cdr change))))))) + +(unless (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + ;; Before `syntax-propertize', we had to use font-lock to apply syntax-table + ;; properties, and in some cases we even had to do it manually (in + ;; `ada-after-change-function'). `ada-handle-syntax-table-properties' + ;; decides which method to use. + +(defun ada-set-syntax-table-properties () + "Assign `syntax-table' properties in accessible part of buffer. +In particular, character constants are said to be strings, #...# +are treated as numbers instead of gnatprep comments." + (let ((modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + (inhibit-point-motion-hooks t) + (inhibit-modification-hooks t)) + (remove-text-properties (point-min) (point-max) '(syntax-table nil)) + (goto-char (point-min)) + (while (re-search-forward + ;; The following regexp was adapted from + ;; `ada-font-lock-syntactic-keywords'. + "^[ \t]*\\(#\\(?:if\\|else\\|elsif\\|end\\)\\)\\|[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" + nil t) + (if (match-beginning 1) + (put-text-property + (match-beginning 1) (match-end 1) 'syntax-table '(11 . ?\n)) + (put-text-property + (match-beginning 2) (match-end 2) 'syntax-table '(7 . ?')) + (put-text-property + (match-beginning 3) (match-end 3) 'syntax-table '(7 . ?')))) + (unless modified + (restore-buffer-modified-p nil)))) + +(defun ada-after-change-function (beg end _old-len) + "Called when the region between BEG and END was changed in the buffer. +OLD-LEN indicates what the length of the replaced text was." + (save-excursion + (save-restriction + (let ((from (progn (goto-char beg) (line-beginning-position))) + (to (progn (goto-char end) (line-end-position)))) + (narrow-to-region from to) + (save-match-data + (ada-set-syntax-table-properties)))))) + +(defun ada-initialize-syntax-table-properties () + "Assign `syntax-table' properties in current buffer." + (save-excursion + (save-restriction + (widen) + (save-match-data + (ada-set-syntax-table-properties)))) + (add-hook 'after-change-functions 'ada-after-change-function nil t)) + +(defun ada-handle-syntax-table-properties () + "Handle `syntax-table' properties." + (if font-lock-mode + ;; `font-lock-mode' will take care of `syntax-table' properties. + (remove-hook 'after-change-functions 'ada-after-change-function t) + ;; Take care of `syntax-table' properties manually. + (ada-initialize-syntax-table-properties))) + +) ;;(not (fboundp 'syntax-propertize)) + +;;------------------------------------------------------------------ +;; Testing the grammatical context +;;------------------------------------------------------------------ + +(defsubst ada-in-comment-p (&optional parse-result) + "Return t if inside a comment. +If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'." + (nth 4 (or parse-result + (parse-partial-sexp + (line-beginning-position) (point))))) + +(defsubst ada-in-string-p (&optional parse-result) + "Return t if point is inside a string. +If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'." + (nth 3 (or parse-result + (parse-partial-sexp + (line-beginning-position) (point))))) + +(defsubst ada-in-string-or-comment-p (&optional parse-result) + "Return t if inside a comment or string. +If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'." + (setq parse-result (or parse-result + (parse-partial-sexp + (line-beginning-position) (point)))) + (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result))) + +(defsubst ada-in-numeric-literal-p () + "Return t if point is after a prefix of a numeric literal." + (looking-back "\\([0-9]+#[[:xdigit:]_]+\\)" (line-beginning-position))) + +;;------------------------------------------------------------------ +;; Contextual menus +;; The Ada mode comes with contextual menus, bound by default to the right +;; mouse button. +;; Add items to this menu by modifying `ada-contextual-menu'. Note that the +;; variable `ada-contextual-menu-on-identifier' is set automatically to t +;; if the mouse button was pressed on an identifier. +;;------------------------------------------------------------------ + +(defun ada-call-from-contextual-menu (function) + "Execute FUNCTION when called from the contextual menu. +It forces Emacs to change the cursor position." + (interactive) + (funcall function) + (setq ada-contextual-menu-last-point + (list (point) (current-buffer)))) + +(defun ada-popup-menu (position) + "Pops up a contextual menu, depending on where the user clicked. +POSITION is the location the mouse was clicked on. +Sets `ada-contextual-menu-last-point' to the current position before +displaying the menu. When a function from the menu is called, the +point is where the mouse button was clicked." + (interactive "e") + + ;; declare this as a local variable, so that the function called + ;; in the contextual menu does not hide the region in + ;; transient-mark-mode. + (let ((deactivate-mark nil)) + (setq ada-contextual-menu-last-point + (list (point) (current-buffer))) + (mouse-set-point last-input-event) + + (setq ada-contextual-menu-on-identifier + (and (char-after) + (or (= (char-syntax (char-after)) ?w) + (= (char-after) ?_)) + (not (ada-in-string-or-comment-p)) + (save-excursion (skip-syntax-forward "w") + (not (ada-after-keyword-p))) + )) + (if (fboundp 'popup-menu) + (funcall (symbol-function 'popup-menu) ada-contextual-menu) + (let (choice) + (setq choice (x-popup-menu position ada-contextual-menu)) + (if choice + (funcall (lookup-key ada-contextual-menu (vector (car choice))))))) + + (set-buffer (cadr ada-contextual-menu-last-point)) + (goto-char (car ada-contextual-menu-last-point)) + )) + + +;;------------------------------------------------------------------ +;; Misc functions +;;------------------------------------------------------------------ + +;;;###autoload +(defun ada-add-extensions (spec body) + "Define SPEC and BODY as being valid extensions for Ada files. +Going from body to spec with `ff-find-other-file' used these +extensions. +SPEC and BODY are two regular expressions that must match against +the file name." + (let* ((reg (concat (regexp-quote body) "$")) + (tmp (assoc reg ada-other-file-alist))) + (if tmp + (setcdr tmp (list (cons spec (cadr tmp)))) + (add-to-list 'ada-other-file-alist (list reg (list spec))))) + + (let* ((reg (concat (regexp-quote spec) "$")) + (tmp (assoc reg ada-other-file-alist))) + (if tmp + (setcdr tmp (list (cons body (cadr tmp)))) + (add-to-list 'ada-other-file-alist (list reg (list body))))) + + (add-to-list 'auto-mode-alist + (cons (concat (regexp-quote spec) "\\'") 'ada-mode)) + (add-to-list 'auto-mode-alist + (cons (concat (regexp-quote body) "\\'") 'ada-mode)) + + (add-to-list 'ada-spec-suffixes spec) + (add-to-list 'ada-body-suffixes body) + + ;; Support for speedbar (Specifies that we want to see these files in + ;; speedbar) + (if (fboundp 'speedbar-add-supported-extension) + (progn + (funcall (symbol-function 'speedbar-add-supported-extension) + spec) + (funcall (symbol-function 'speedbar-add-supported-extension) + body)))) + +(defvar ada-font-lock-syntactic-keywords) ; defined below + +;;;###autoload +(define-derived-mode ada-mode prog-mode "Ada" + "Ada mode is the major mode for editing Ada code." + + ;; Set the paragraph delimiters so that one can select a whole block + ;; simply with M-h + (set (make-local-variable 'paragraph-start) "[ \t\n\f]*$") + (set (make-local-variable 'paragraph-separate) "[ \t\n\f]*$") + + ;; comment end must be set because it may hold a wrong value if + ;; this buffer had been in another mode before. RE + (set (make-local-variable 'comment-end) "") + + ;; used by autofill and indent-new-comment-line + (set (make-local-variable 'comment-start-skip) "---*[ \t]*") + + ;; used by autofill to break a comment line and continue it on another line. + ;; The reason we need this one is that the default behavior does not work + ;; correctly with the definition of paragraph-start above when the comment + ;; is right after a multi-line subprogram declaration (the comments are + ;; aligned under the latest parameter, not under the declaration start). + (set (make-local-variable 'comment-line-break-function) + (lambda (&optional soft) (let ((fill-prefix nil)) + (indent-new-comment-line soft)))) + + (set (make-local-variable 'indent-line-function) + 'ada-indent-current-function) + + (set (make-local-variable 'comment-column) 40) + + ;; Emacs 20.3 defines a comment-padding to insert spaces between + ;; the comment and the text. We do not want any, this is already + ;; included in comment-start + (unless (featurep 'xemacs) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'comment-padding) 0) + (set (make-local-variable 'parse-sexp-lookup-properties) t)) + + (setq case-fold-search t) + (if (boundp 'imenu-case-fold-search) + (setq imenu-case-fold-search t)) + + (set (make-local-variable 'fill-paragraph-function) + 'ada-fill-comment-paragraph) + + ;; Support for compile.el + ;; We just substitute our own functions to go to the error. + (add-hook 'compilation-mode-hook + (lambda() + ;; FIXME: This has global impact! -stef + (define-key compilation-minor-mode-map [mouse-2] + 'ada-compile-mouse-goto-error) + (define-key compilation-minor-mode-map "\C-c\C-c" + 'ada-compile-goto-error) + (define-key compilation-minor-mode-map "\C-m" + 'ada-compile-goto-error))) + + ;; font-lock support : + + (set (make-local-variable 'font-lock-defaults) + '(ada-font-lock-keywords + nil t + ((?\_ . "w") (?# . ".")) + beginning-of-line)) + + (if (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock ada-font-lock-syntactic-keywords)) + (set (make-local-variable 'font-lock-syntactic-keywords) + ada-font-lock-syntactic-keywords)) + + ;; Set up support for find-file.el. + (set (make-local-variable 'ff-other-file-alist) + 'ada-other-file-alist) + (set (make-local-variable 'ff-search-directories) + 'ada-search-directories-internal) + (setq ff-post-load-hook 'ada-set-point-accordingly + ff-file-created-hook 'ada-make-body) + (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in) + + (make-local-variable 'ff-special-constructs) + (mapc (lambda (pair) (add-to-list 'ff-special-constructs pair)) + (list + ;; Top level child package declaration; go to the parent package. + (cons (eval-when-compile + (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+" + "\\(body[ \t]+\\)?" + "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is")) + (lambda () + (ff-get-file + ada-search-directories-internal + (ada-make-filename-from-adaname (match-string 3)) + ada-spec-suffixes))) + + ;; A "separate" clause. + (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))" + (lambda () + (ff-get-file + ada-search-directories-internal + (ada-make-filename-from-adaname (match-string 1)) + ada-spec-suffixes))) + + ;; A "with" clause. + (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" + (lambda () + (ff-get-file + ada-search-directories-internal + (ada-make-filename-from-adaname (match-string 1)) + ada-spec-suffixes))) + )) + + ;; Support for outline-minor-mode + (set (make-local-variable 'outline-regexp) + "\\([ \t]*\\(procedure\\|function\\|package\\|if\\|while\\|for\\|declare\\|case\\|end\\|begin\\|loop\\)\\|--\\)") + (set (make-local-variable 'outline-level) 'ada-outline-level) + + ;; Support for imenu : We want a sorted index + (setq imenu-generic-expression ada-imenu-generic-expression) + + (setq imenu-sort-function 'imenu--sort-by-name) + + ;; Support for ispell : Check only comments + (set (make-local-variable 'ispell-check-comments) 'exclusive) + + ;; Support for align + (add-to-list 'align-dq-string-modes 'ada-mode) + (add-to-list 'align-open-comment-modes 'ada-mode) + (set (make-local-variable 'align-region-separate) ada-align-region-separate) + + ;; Exclude comments alone on line from alignment. + (add-to-list 'align-exclude-rules-list + '(ada-solo-comment + (regexp . "^\\(\\s-*\\)--") + (modes . '(ada-mode)))) + (add-to-list 'align-exclude-rules-list + '(ada-solo-use + (regexp . "^\\(\\s-*\\)\\") + (modes . '(ada-mode)))) + + (setq ada-align-modes nil) + + (add-to-list 'ada-align-modes + '(ada-declaration-assign + (regexp . "[^:]\\(\\s-*\\):[^:]") + (valid . (lambda() (not (ada-in-comment-p)))) + (repeat . t) + (modes . '(ada-mode)))) + (add-to-list 'ada-align-modes + '(ada-associate + (regexp . "[^=]\\(\\s-*\\)=>") + (valid . (lambda() (not (ada-in-comment-p)))) + (modes . '(ada-mode)))) + (add-to-list 'ada-align-modes + '(ada-comment + (regexp . "\\(\\s-*\\)--") + (modes . '(ada-mode)))) + (add-to-list 'ada-align-modes + '(ada-use + (regexp . "\\(\\s-*\\)\\") + (modes . '(ada-mode)))) + + (setq align-mode-rules-list ada-align-modes) + + ;; Set up the contextual menu + (if ada-popup-key + (define-key ada-mode-map ada-popup-key 'ada-popup-menu)) + + ;; Support for Abbreviations (the user still needs to "M-x abbrev-mode"). + (setq local-abbrev-table ada-mode-abbrev-table) + + ;; Support for which-function mode + (set (make-local-variable 'which-func-functions) '(ada-which-function)) + + ;; Support for indent-new-comment-line (Especially for XEmacs) + (set (make-local-variable 'comment-multi-line) nil) + + ;; Support for add-log + (set (make-local-variable 'add-log-current-defun-function) + 'ada-which-function) + + (easy-menu-add ada-mode-menu ada-mode-map) + + (set (make-local-variable 'skeleton-further-elements) + '((< '(backward-delete-char-untabify + (min ada-indent (current-column)))))) + (add-hook 'skeleton-end-hook 'ada-adjust-case-skeleton nil t) + + ;; To be run after the hook, in case the user modified + ;; ada-fill-comment-prefix + (add-hook 'hack-local-variables-hook + (lambda () + (set (make-local-variable 'comment-start) + (or ada-fill-comment-prefix "-- ")) + + ;; Run this after the hook to give the users a chance + ;; to activate font-lock-mode. + + (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + (featurep 'xemacs)) + (ada-initialize-syntax-table-properties) + (add-hook 'font-lock-mode-hook + 'ada-handle-syntax-table-properties nil t)) + + ;; FIXME: ada-language-version might be set in the mode + ;; hook or it might even be set later on via file-local + ;; vars, so ada-keywords should be set lazily. + (cond ((eq ada-language-version 'ada83) + (setq ada-keywords ada-83-keywords)) + ((eq ada-language-version 'ada95) + (setq ada-keywords ada-95-keywords)) + ((eq ada-language-version 'ada2005) + (setq ada-keywords ada-2005-keywords))) + + (if ada-auto-case + (ada-activate-keys-for-case))) + nil 'local)) + +(defun ada-adjust-case-skeleton () + "Adjust the case of the text inserted by a skeleton." + (save-excursion + (let ((aa-end (point))) + (ada-adjust-case-region + (progn (goto-char (symbol-value 'beg)) (forward-word-strictly -1) + (point)) + (goto-char aa-end))))) + +(defun ada-region-selected () + "Should we operate on an active region?" + (if (fboundp 'use-region-p) + (use-region-p) + (region-active-p))) + +;;----------------------------------------------------------------- +;; auto-casing +;; Since Ada is case-insensitive, the Ada mode provides an extensive set of +;; functions to auto-case identifiers, keywords, ... +;; The basic rules for autocasing are defined through the variables +;; `ada-case-attribute', `ada-case-keyword' and `ada-case-identifier'. These +;; are references to the functions that will do the actual casing. +;; +;; However, in most cases, the user will want to define some exceptions to +;; these casing rules. This is done through a list of files, that contain +;; one word per line. These files are stored in `ada-case-exception-file'. +;; For backward compatibility, this variable can also be a string. +;;----------------------------------------------------------------- + +(defun ada-save-exceptions-to-file (file-name) + "Save the casing exception lists to the file FILE-NAME. +Casing exception lists are `ada-case-exception' and `ada-case-exception-substring'." + (find-file (expand-file-name file-name)) + (erase-buffer) + (mapc (lambda (x) (insert (car x) "\n")) + (sort (copy-sequence ada-case-exception) + (lambda(a b) (string< (car a) (car b))))) + (mapc (lambda (x) (insert "*" (car x) "\n")) + (sort (copy-sequence ada-case-exception-substring) + (lambda(a b) (string< (car a) (car b))))) + (save-buffer) + (kill-buffer nil) + ) + +(defun ada-create-case-exception (&optional word) + "Define WORD as an exception for the casing system. +If WORD is not given, then the current word in the buffer is used instead. +The new word is added to the first file in `ada-case-exception-file'. +The standard casing rules will no longer apply to this word." + (interactive) + (let ((file-name + (cond ((stringp ada-case-exception-file) + ada-case-exception-file) + ((listp ada-case-exception-file) + (car ada-case-exception-file)) + (t + (error (concat "No exception file specified. " + "See variable ada-case-exception-file")))))) + + (unless word + (with-syntax-table ada-mode-symbol-syntax-table + (save-excursion + (skip-syntax-backward "w") + (setq word (buffer-substring-no-properties + (point) (save-excursion (forward-word-strictly 1) + (point))))))) + + ;; Reread the exceptions file, in case it was modified by some other, + (ada-case-read-exceptions-from-file file-name) + + ;; If the word is already in the list, even with a different casing + ;; we simply want to replace it. + (if (and (not (equal ada-case-exception '())) + (assoc-string word ada-case-exception t)) + (setcar (assoc-string word ada-case-exception t) word) + (add-to-list 'ada-case-exception (cons word t))) + + (ada-save-exceptions-to-file file-name))) + +(defun ada-create-case-exception-substring (&optional word) + "Define the substring WORD as an exception for the casing system. +If WORD is not given, then the current word in the buffer is used instead, +or the selected region if any is active. +The new word is added to the first file in `ada-case-exception-file'. +When auto-casing a word, this substring will be special-cased, unless the +word itself has a special casing." + (interactive) + (let ((file-name + (cond ((stringp ada-case-exception-file) + ada-case-exception-file) + ((listp ada-case-exception-file) + (car ada-case-exception-file)) + (t + (error (concat "No exception file specified. " + "See variable ada-case-exception-file")))))) + + ;; Find the substring to define as an exception. Order is: the parameter, + ;; if any, or the selected region, or the word under the cursor + (cond + (word nil) + + ((ada-region-selected) + (setq word (buffer-substring-no-properties + (region-beginning) (region-end)))) + + (t + (let ((underscore-syntax (char-syntax ?_))) + (unwind-protect + (progn + (modify-syntax-entry ?_ "." (syntax-table)) + (save-excursion + (skip-syntax-backward "w") + (setq word (buffer-substring-no-properties + (point) + (save-excursion (forward-word-strictly 1) + (point)))))) + (modify-syntax-entry ?_ (make-string 1 underscore-syntax) + (syntax-table)))))) + + ;; Reread the exceptions file, in case it was modified by some other, + (ada-case-read-exceptions-from-file file-name) + + ;; If the word is already in the list, even with a different casing + ;; we simply want to replace it. + (if (and (not (equal ada-case-exception-substring '())) + (assoc-string word ada-case-exception-substring t)) + (setcar (assoc-string word ada-case-exception-substring t) word) + (add-to-list 'ada-case-exception-substring (cons word t)) + ) + + (ada-save-exceptions-to-file file-name) + + (message "%s" (concat "Defining " word " as a casing exception")))) + +(defun ada-case-read-exceptions-from-file (file-name) + "Read the content of the casing exception file FILE-NAME." + (if (file-readable-p (expand-file-name file-name)) + (let ((buffer (current-buffer))) + (find-file (expand-file-name file-name)) + (set-syntax-table ada-mode-symbol-syntax-table) + (widen) + (goto-char (point-min)) + (while (not (eobp)) + + ;; If the item is already in the list, even with an other casing, + ;; do not add it again. This way, the user can easily decide which + ;; priority should be applied to each casing exception + (let ((word (buffer-substring-no-properties + (point) (save-excursion (forward-word-strictly 1) + (point))))) + + ;; Handling a substring ? + (if (char-equal (string-to-char word) ?*) + (progn + (setq word (substring word 1)) + (unless (assoc-string word ada-case-exception-substring t) + (add-to-list 'ada-case-exception-substring (cons word t)))) + (unless (assoc-string word ada-case-exception t) + (add-to-list 'ada-case-exception (cons word t))))) + + (forward-line 1)) + (kill-buffer nil) + (set-buffer buffer))) + ) + +(defun ada-case-read-exceptions () + "Read all the casing exception files from `ada-case-exception-file'." + (interactive) + + ;; Reinitialize the casing exception list + (setq ada-case-exception '() + ada-case-exception-substring '()) + + (cond ((stringp ada-case-exception-file) + (ada-case-read-exceptions-from-file ada-case-exception-file)) + + ((listp ada-case-exception-file) + (mapcar 'ada-case-read-exceptions-from-file + ada-case-exception-file)))) + +(defun ada-adjust-case-substring () + "Adjust case of substrings in the previous word." + (interactive) + (let ((substrings ada-case-exception-substring) + (max (point)) + (case-fold-search t) + (underscore-syntax (char-syntax ?_)) + re) + + (save-excursion + (forward-word -1) + + (unwind-protect + (progn + (modify-syntax-entry ?_ "." (syntax-table)) + + (while substrings + (setq re (concat "\\b" (regexp-quote (caar substrings)) "\\b")) + + (save-excursion + (while (re-search-forward re max t) + (replace-match (caar substrings) t))) + (setq substrings (cdr substrings)) + ) + ) + (modify-syntax-entry ?_ (make-string 1 underscore-syntax) (syntax-table))) + ))) + +(defun ada-adjust-case-identifier () + "Adjust case of the previous identifier. +The auto-casing is done according to the value of `ada-case-identifier' +and the exceptions defined in `ada-case-exception-file'." + (interactive) + (if (or (equal ada-case-exception '()) + (equal (char-after) ?_)) + (progn + (funcall ada-case-identifier -1) + (ada-adjust-case-substring)) + + (progn + (let ((end (point)) + (start (save-excursion (skip-syntax-backward "w") + (point))) + match) + ;; If we have an exception, replace the word by the correct casing + (if (setq match (assoc-string (buffer-substring start end) + ada-case-exception t)) + + (progn + (delete-region start end) + (insert (car match))) + + ;; Else simply re-case the word + (funcall ada-case-identifier -1) + (ada-adjust-case-substring)))))) + +(defun ada-after-keyword-p () + "Return t if cursor is after a keyword that is not an attribute." + (save-excursion + (forward-word-strictly -1) + (and (not (and (char-before) + (or (= (char-before) ?_) + (= (char-before) ?'))));; unless we have a _ or ' + (looking-at (concat ada-keywords "[^_]"))))) + +(defun ada-adjust-case (&optional force-identifier) + "Adjust the case of the word before the character just typed. +If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." + (if (not (bobp)) + (progn + (forward-char -1) + (if (and (not (bobp)) + ;; or if at the end of a character constant + (not (and (eq (following-char) ?') + (eq (char-before (1- (point))) ?'))) + ;; or if the previous character was not part of a word + (eq (char-syntax (char-before)) ?w) + ;; if in a string or a comment + (not (ada-in-string-or-comment-p)) + ;; if in a numeric literal + (not (ada-in-numeric-literal-p)) + ) + (if (save-excursion + (forward-word -1) + (or (= (point) (point-min)) + (backward-char 1)) + (= (following-char) ?')) + (funcall ada-case-attribute -1) + (if (and + (not force-identifier) ; (MH) + (ada-after-keyword-p)) + (funcall ada-case-keyword -1) + (ada-adjust-case-identifier)))) + (forward-char 1) + )) + ) + +(defun ada-adjust-case-interactive (arg) + "Adjust the case of the previous word, and process the character just typed. +ARG is the prefix the user entered with \\[universal-argument]." + (interactive "P") + + (if ada-auto-case + (let ((lastk last-command-event)) + + (with-syntax-table ada-mode-symbol-syntax-table + (cond ((memq lastk '(?\n ?\r)) + ;; Horrible kludge. + (insert " ") + (ada-adjust-case) + ;; horrible dekludge + (delete-char -1) + ;; some special keys and their bindings + (cond + ((eq lastk ?\n) + (funcall ada-lfd-binding)) + ((eq lastk ?\r) + (funcall ada-ret-binding)))) + ((eq lastk ?\C-i) (ada-tab)) + ;; Else just insert the character + ((self-insert-command (prefix-numeric-value arg)))) + ;; if there is a keyword in front of the underscore + ;; then it should be part of an identifier (MH) + (if (eq lastk ?_) + (ada-adjust-case t) + (ada-adjust-case)))) + + ;; Else, no auto-casing + (cond + ((eq last-command-event ?\n) + (funcall ada-lfd-binding)) + ((eq last-command-event ?\r) + (funcall ada-ret-binding)) + (t + (self-insert-command (prefix-numeric-value arg)))))) + +(defun ada-activate-keys-for-case () + ;; FIXME: Use post-self-insert-hook instead of changing key bindings. + "Modify the key bindings for all the keys that should readjust the casing." + (interactive) + ;; Save original key-bindings to allow swapping ret/lfd + ;; when casing is activated. + ;; The 'or ...' is there to be sure that the value will not + ;; be changed again when Ada mode is called more than once + (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M"))) + (or ada-lfd-binding (setq ada-lfd-binding (key-binding "\C-j"))) + + ;; Call case modifying function after certain keys. + (mapcar (function (lambda(key) (define-key + ada-mode-map + (char-to-string key) + 'ada-adjust-case-interactive))) + '( ?` ?_ ?# ?% ?& ?* ?\( ?\) ?- ?= ?+ + ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))) + +(defun ada-loose-case-word (&optional _arg) + "Upcase first letter and letters following `_' in the following word. +No other letter is modified. +ARG is ignored, and is there for compatibility with `capitalize-word' only." + (interactive) + (save-excursion + (let ((end (save-excursion (skip-syntax-forward "w") (point))) + (first t)) + (skip-syntax-backward "w") + (while (and (or first (search-forward "_" end t)) + (< (point) end)) + (and first + (setq first nil)) + (insert-char (upcase (following-char)) 1) + (delete-char 1))))) + +(defun ada-no-auto-case (&optional _arg) + "Do nothing. ARG is ignored. +This function can be used for the auto-casing variables in Ada mode, to +adapt to unusual auto-casing schemes. Since it does nothing, you can for +instance use it for `ada-case-identifier' if you don't want any special +auto-casing for identifiers, whereas keywords have to be lower-cased. +See also `ada-auto-case' to disable auto casing altogether." + nil) + +(defun ada-capitalize-word (&optional _arg) + "Upcase first letter and letters following `_', lower case other letters. +ARG is ignored, and is there for compatibility with `capitalize-word' only." + (interactive) + (let ((end (save-excursion (skip-syntax-forward "w") (point))) + (begin (save-excursion (skip-syntax-backward "w") (point)))) + (capitalize-region begin end))) + +(defun ada-adjust-case-region (from to) + "Adjust the case of all words in the region between FROM and TO. +Attention: This function might take very long for big regions!" + (interactive "*r") + (let ((begin nil) + (end nil) + (keywordp nil) + (attribp nil)) + (message "Adjusting case ...") + (with-syntax-table ada-mode-symbol-syntax-table + (save-excursion + (goto-char to) + ;; + ;; loop: look for all identifiers, keywords, and attributes + ;; + (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) + (setq end (match-end 1)) + (setq attribp + (and (> (point) from) + (save-excursion + (forward-char -1) + (setq attribp (looking-at "'.[^']"))))) + (or + ;; do nothing if it is a string or comment + (ada-in-string-or-comment-p) + (progn + ;; + ;; get the identifier or keyword or attribute + ;; + (setq begin (point)) + (setq keywordp (looking-at ada-keywords)) + (goto-char end) + ;; + ;; casing according to user-option + ;; + (if attribp + (funcall ada-case-attribute -1) + (if keywordp + (funcall ada-case-keyword -1) + (ada-adjust-case-identifier))) + (goto-char begin)))) + (message "Adjusting case ... Done"))))) + +(defun ada-adjust-case-buffer () + "Adjust the case of all words in the whole buffer. +ATTENTION: This function might take very long for big buffers!" + (interactive "*") + (ada-adjust-case-region (point-min) (point-max))) + + +;;-------------------------------------------------------------- +;; Format Parameter Lists +;; Some special algorithms are provided to indent the parameter lists in +;; subprogram declarations. This is done in two steps: +;; - First parses the parameter list. The returned list has the following +;; format: +;; ( ( in? out? access? ) +;; ... ) +;; This is done in `ada-scan-paramlist'. +;; - Delete and recreate the parameter list in function +;; `ada-insert-paramlist'. +;; Both steps are called from `ada-format-paramlist'. +;; Note: Comments inside the parameter list are lost. +;; The syntax has to be correct, or the reformatting will fail. +;;-------------------------------------------------------------- + +(defun ada-format-paramlist () + "Reformat the parameter list point is in." + (interactive) + (let ((begin nil) + (end nil) + (delend nil) + (paramlist nil)) + (with-syntax-table ada-mode-symbol-syntax-table + + ;; check if really inside parameter list + (or (ada-in-paramlist-p) + (error "Not in parameter list")) + + ;; find start of current parameter-list + (ada-search-ignore-string-comment + (concat ada-subprog-start-re "\\|\\" ) t nil) + (down-list 1) + (backward-char 1) + (setq begin (point)) + + ;; find end of parameter-list + (forward-sexp 1) + (setq delend (point)) + (delete-char -1) + (insert "\n") + + ;; find end of last parameter-declaration + (forward-comment -1000) + (setq end (point)) + + ;; build a list of all elements of the parameter-list + (setq paramlist (ada-scan-paramlist (1+ begin) end)) + + ;; delete the original parameter-list + (delete-region begin delend) + + ;; insert the new parameter-list + (goto-char begin) + (ada-insert-paramlist paramlist)))) + +(defun ada-scan-paramlist (begin end) + "Scan the parameter list found in between BEGIN and END. +Return the equivalent internal parameter list." + (let ((paramlist (list)) + (param (list)) + (notend t) + (apos nil) + (epos nil) + (semipos nil) + (match-cons nil)) + + (goto-char begin) + + ;; loop until end of last parameter + (while notend + + ;; find first character of parameter-declaration + (ada-goto-next-non-ws) + (setq apos (point)) + + ;; find last character of parameter-declaration + (if (setq match-cons + (ada-search-ignore-string-comment "[ \t\n]*;" nil end t)) + (progn + (setq epos (car match-cons)) + (setq semipos (cdr match-cons))) + (setq epos end)) + + ;; read name(s) of parameter(s) + (goto-char apos) + (looking-at "\\(\\(\\sw\\|[_, \t\n]\\)*\\(\\sw\\|_\\)\\)[ \t\n]*:[^=]") + + (setq param (list (match-string 1))) + (ada-search-ignore-string-comment ":" nil epos t 'search-forward) + + ;; look for 'in' + (setq apos (point)) + (setq param + (append param + (list + (consp + (ada-search-ignore-string-comment + "in" nil epos t 'word-search-forward))))) + + ;; look for 'out' + (goto-char apos) + (setq param + (append param + (list + (consp + (ada-search-ignore-string-comment + "out" nil epos t 'word-search-forward))))) + + ;; look for 'access' + (goto-char apos) + (setq param + (append param + (list + (consp + (ada-search-ignore-string-comment + "access" nil epos t 'word-search-forward))))) + + ;; skip 'in'/'out'/'access' + (goto-char apos) + (ada-goto-next-non-ws) + (while (looking-at "\\<\\(in\\|out\\|access\\)\\>") + (forward-word-strictly 1) + (ada-goto-next-non-ws)) + + ;; read type of parameter + ;; We accept spaces in the name, since some software like Rose + ;; generates something like: "A : B 'Class" + (looking-at "\\<\\(\\sw\\|[_.' \t]\\)+\\>") + (setq param + (append param + (list (match-string 0)))) + + ;; read default-expression, if there is one + (goto-char (setq apos (match-end 0))) + (setq param + (append param + (list + (if (setq match-cons + (ada-search-ignore-string-comment + ":=" nil epos t 'search-forward)) + (buffer-substring (car match-cons) epos) + nil)))) + + ;; add this parameter-declaration to the list + (setq paramlist (append paramlist (list param))) + + ;; check if it was the last parameter + (if (eq epos end) + (setq notend nil) + (goto-char semipos)) + ) + (reverse paramlist))) + +(defun ada-insert-paramlist (paramlist) + "Insert a formatted PARAMLIST in the buffer." + (let ((i (length paramlist)) + (parlen 0) + (typlen 0) + (inp nil) + (outp nil) + (accessp nil) + (column nil) + (firstcol nil)) + + ;; loop until last parameter + (while (not (zerop i)) + (setq i (1- i)) + + ;; get max length of parameter-name + (setq parlen (max parlen (length (nth 0 (nth i paramlist))))) + + ;; get max length of type-name + (setq typlen (max typlen (length (nth 4 (nth i paramlist))))) + + ;; is there any 'in' ? + (setq inp (or inp (nth 1 (nth i paramlist)))) + + ;; is there any 'out' ? + (setq outp (or outp (nth 2 (nth i paramlist)))) + + ;; is there any 'access' ? + (setq accessp (or accessp (nth 3 (nth i paramlist)))) + ) + + ;; does paramlist already start on a separate line ? + (if (save-excursion + (re-search-backward "^.\\|[^ \t]" nil t) + (looking-at "^.")) + ;; yes => re-indent it + (progn + (ada-indent-current) + (save-excursion + (if (looking-at "\\(is\\|return\\)") + (replace-match " \\1")))) + + ;; no => insert it where we are after removing any whitespace + (fixup-whitespace) + (save-excursion + (cond + ((looking-at "[ \t]*\\(\n\\|;\\)") + (replace-match "\\1")) + ((looking-at "[ \t]*\\(is\\|return\\)") + (replace-match " \\1")))) + (insert " ")) + + (insert "(") + (ada-indent-current) + + (setq firstcol (current-column)) + (setq i (length paramlist)) + + ;; loop until last parameter + (while (not (zerop i)) + (setq i (1- i)) + (setq column firstcol) + + ;; insert parameter-name, space and colon + (insert (nth 0 (nth i paramlist))) + (indent-to (+ column parlen 1)) + (insert ": ") + (setq column (current-column)) + + ;; insert 'in' or space + (if (nth 1 (nth i paramlist)) + (insert "in ") + (if (and + (or inp + accessp) + (not (nth 3 (nth i paramlist)))) + (insert " "))) + + ;; insert 'out' or space + (if (nth 2 (nth i paramlist)) + (insert "out ") + (if (and + (or outp + accessp) + (not (nth 3 (nth i paramlist)))) + (insert " "))) + + ;; insert 'access' + (if (nth 3 (nth i paramlist)) + (insert "access ")) + + (setq column (current-column)) + + ;; insert type-name and, if necessary, space and default-expression + (insert (nth 4 (nth i paramlist))) + (if (nth 5 (nth i paramlist)) + (progn + (indent-to (+ column typlen 1)) + (insert (nth 5 (nth i paramlist))))) + + ;; check if it was the last parameter + (if (zerop i) + (insert ")") + ;; no => insert ';' and newline and indent + (insert ";") + (newline) + (indent-to firstcol)) + ) + + ;; if anything follows, except semicolon, newline, is or return + ;; put it in a new line and indent it + (unless (looking-at "[ \t]*\\(;\\|\n\\|is\\|return\\)") + (ada-indent-newline-indent)) + )) + + + +;;;---------------------------------------------------------------- +;; Indentation Engine +;; All indentations are indicated as a two-element string: +;; - position of reference in the buffer +;; - offset to indent from this position (can also be a symbol or a list +;; that are evaluated) +;; Thus the total indentation for a line is the column number of the reference +;; position plus whatever value the evaluation of the second element provides. +;; This mechanism is used so that the Ada mode can "explain" how the +;; indentation was calculated, by showing which variables were used. +;; +;; The indentation itself is done in only one pass: first we try to guess in +;; what context we are by looking at the following keyword or punctuation +;; sign. If nothing remarkable is found, just try to guess the indentation +;; based on previous lines. +;; +;; The relevant functions for indentation are: +;; - `ada-indent-region': Re-indent a region of text +;; - `ada-justified-indent-current': Re-indent the current line and shows the +;; calculation that were done +;; - `ada-indent-current': Re-indent the current line +;; - `ada-get-current-indent': Calculate the indentation for the current line, +;; based on the context (see above). +;; - `ada-get-indent-*': Calculate the indentation in a specific context. +;; For efficiency, these functions do not check they are in the correct +;; context. +;;;---------------------------------------------------------------- + +(defun ada-indent-region (beg end) + "Indent the region between BEG end END." + (interactive "*r") + (goto-char beg) + (let ((block-done 0) + (lines-remaining (count-lines beg end)) + (msg (format "%%4d out of %4d lines remaining ..." + (count-lines beg end))) + (endmark (copy-marker end))) + ;; catch errors while indenting + (while (< (point) endmark) + (if (> block-done 39) + (progn + (setq lines-remaining (- lines-remaining block-done) + block-done 0) + (message msg lines-remaining))) + (if (= (char-after) ?\n) nil + (ada-indent-current)) + (forward-line 1) + (setq block-done (1+ block-done))) + (message "Indenting ... done"))) + +(defun ada-indent-newline-indent () + "Indent the current line, insert a newline and then indent the new line." + (interactive "*") + (ada-indent-current) + (newline) + (ada-indent-current)) + +(defun ada-indent-newline-indent-conditional () + "Insert a newline and indent it. +The original line is re-indented if `ada-indent-after-return' is non-nil." + (interactive "*") + ;; If at end of buffer (entering brand new code), some indentation + ;; fails. For example, a block label requires whitespace following + ;; the : to be recognized. So we do the newline first, then + ;; go back and indent the original line. + (newline) + (if ada-indent-after-return + (progn + (forward-char -1) + (ada-indent-current) + (forward-char 1))) + (ada-indent-current)) + +(defun ada-justified-indent-current () + "Indent the current line and explain how the calculation was done." + (interactive) + + (let ((cur-indent (ada-indent-current))) + + (let ((line (save-excursion + (goto-char (car cur-indent)) + (count-lines 1 (point))))) + + (if (equal (cdr cur-indent) '(0)) + (message (concat "same indentation as line " (number-to-string line))) + (message "%s" (mapconcat (lambda(x) + (cond + ((symbolp x) + (symbol-name x)) + ((numberp x) + (number-to-string x)) + ((listp x) + (concat "- " (symbol-name (cadr x)))) + )) + (cdr cur-indent) + " + ")))) + (save-excursion + (goto-char (car cur-indent)) + (sit-for 1)))) + +(defun ada-batch-reformat () + "Re-indent and re-case all the files found on the command line. +This function should be used from the command line, with a +command like: + emacs -batch -l ada-mode -f ada-batch-reformat file1 file2 ..." + + (while command-line-args-left + (let ((source (car command-line-args-left))) + (message "Formatting %s" source) + (find-file source) + (ada-indent-region (point-min) (point-max)) + (ada-adjust-case-buffer) + (write-file source)) + (setq command-line-args-left (cdr command-line-args-left))) + (message "Done") + (kill-emacs 0)) + +(defsubst ada-goto-previous-word () + "Move point to the beginning of the previous word of Ada code. +Return the new position of point or nil if not found." + (ada-goto-next-word t)) + +(defun ada-indent-current () + "Indent current line as Ada code. +Return the calculation that was done, including the reference point +and the offset." + (interactive) + (let ((orgpoint (point-marker)) + cur-indent tmp-indent + prev-indent) + + (unwind-protect + (with-syntax-table ada-mode-symbol-syntax-table + + ;; This needs to be done here so that the advice is not always + ;; activated (this might interact badly with other modes) + (if (featurep 'xemacs) + (ad-activate 'parse-partial-sexp t)) + + (save-excursion + (setq cur-indent + + ;; Not First line in the buffer ? + (if (save-excursion (zerop (forward-line -1))) + (progn + (back-to-indentation) + (ada-get-current-indent)) + + ;; first line in the buffer + (list (point-min) 0)))) + + ;; Evaluate the list to get the column to indent to + ;; prev-indent contains the column to indent to + (if cur-indent + (setq prev-indent (save-excursion (goto-char (car cur-indent)) + (current-column)) + tmp-indent (cdr cur-indent)) + (setq prev-indent 0 tmp-indent '())) + + (while (not (null tmp-indent)) + (cond + ((numberp (car tmp-indent)) + (setq prev-indent (+ prev-indent (car tmp-indent)))) + (t + (setq prev-indent (+ prev-indent (eval (car tmp-indent))))) + ) + (setq tmp-indent (cdr tmp-indent))) + + ;; only re-indent if indentation is different then the current + (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent) + nil + (beginning-of-line) + (delete-horizontal-space) + (indent-to prev-indent)) + ;; + ;; restore position of point + ;; + (goto-char orgpoint) + (if (< (current-column) (current-indentation)) + (back-to-indentation))) + + (if (featurep 'xemacs) + (ad-deactivate 'parse-partial-sexp))) + + cur-indent)) + +(defun ada-get-current-indent () + "Return the indentation to use for the current line." + (let (column + pos + match-cons + result + (orgpoint (save-excursion + (beginning-of-line) + (forward-comment -10000) + (forward-line 1) + (point)))) + + (setq result + (cond + + ;;----------------------------- + ;; in open parenthesis, but not in parameter-list + ;;----------------------------- + + ((and ada-indent-to-open-paren + (not (ada-in-paramlist-p)) + (setq column (ada-in-open-paren-p))) + + ;; check if we have something like this (Table_Component_Type => + ;; Source_File_Record) + (save-excursion + + ;; Align the closing parenthesis on the opening one + (if (= (following-char) ?\)) + (save-excursion + (goto-char column) + (skip-chars-backward " \t") + (list (1- (point)) 0)) + + (if (and (skip-chars-backward " \t") + (= (char-before) ?\n) + (not (forward-comment -10000)) + (= (char-before) ?>)) + ;; ??? Could use a different variable + (list column 'ada-broken-indent) + + ;; We want all continuation lines to be indented the same + ;; (ada-broken-line from the opening parenthesis. However, in + ;; parameter list, each new parameter should be indented at the + ;; column as the opening parenthesis. + + ;; A special case to handle nested boolean expressions, as in + ;; ((B + ;; and then C) -- indented by ada-broken-indent + ;; or else D) -- indenting this line. + ;; ??? This is really a hack, we should have a proper way to go to + ;; ??? the beginning of the statement + + (if (= (char-before) ?\)) + (backward-sexp)) + + (if (memq (char-before) '(?, ?\; ?\( ?\))) + (list column 0) + (list column 'ada-continuation-indent) + ))))) + + ;;--------------------------- + ;; at end of buffer + ;;--------------------------- + + ((not (char-after)) + (ada-indent-on-previous-lines nil orgpoint orgpoint)) + + ;;--------------------------- + ;; starting with e + ;;--------------------------- + + ((= (downcase (char-after)) ?e) + (cond + + ;; ------- end ------ + + ((looking-at "end\\>") + (let ((label 0) + limit) + (save-excursion + (ada-goto-matching-start 1) + + ;; + ;; found 'loop' => skip back to 'while' or 'for' + ;; if 'loop' is not on a separate line + ;; Stop the search for 'while' and 'for' when a ';' is encountered. + ;; + (if (save-excursion + (beginning-of-line) + (looking-at ".+\\")) + (progn + (save-excursion + (setq limit (car (ada-search-ignore-string-comment ";" t)))) + (if (save-excursion + (and + (setq match-cons + (ada-search-ignore-string-comment ada-loop-start-re t limit)) + (not (looking-at "\\")))) + (progn + (goto-char (car match-cons)) + (save-excursion + (back-to-indentation) + (if (looking-at ada-block-label-re) + (setq label (- ada-label-indent)))))))) + + ;; found 'record' => + ;; if the keyword is found at the beginning of a line (or just + ;; after limited, we indent on it, otherwise we indent on the + ;; beginning of the type declaration) + ;; type A is (B : Integer; + ;; C : Integer) is record + ;; end record; -- This is badly indented otherwise + (if (looking-at "record") + (if (save-excursion + (beginning-of-line) + (looking-at "^[ \t]*\\(record\\|limited record\\)")) + (list (save-excursion (back-to-indentation) (point)) 0) + (list (save-excursion + (car (ada-search-ignore-string-comment "\\" t))) + 0)) + + ;; Else keep the same indentation as the beginning statement + (list (+ (save-excursion (back-to-indentation) (point)) label) 0))))) + + ;; ------ exception ---- + + ((looking-at "exception\\>") + (save-excursion + (ada-goto-matching-start 1) + (list (save-excursion (back-to-indentation) (point)) 0))) + + ;; else + + ((looking-at "else\\>") + (if (save-excursion (ada-goto-previous-word) + (looking-at "\\")) + (ada-indent-on-previous-lines nil orgpoint orgpoint) + (save-excursion + (ada-goto-matching-start 1 nil t) + (list (progn (back-to-indentation) (point)) 0)))) + + ;; elsif + + ((looking-at "elsif\\>") + (save-excursion + (ada-goto-matching-start 1 nil t) + (list (progn (back-to-indentation) (point)) 0))) + + )) + + ;;--------------------------- + ;; starting with w (when) + ;;--------------------------- + + ((and (= (downcase (char-after)) ?w) + (looking-at "when\\>")) + (save-excursion + (ada-goto-matching-start 1) + (list (save-excursion (back-to-indentation) (point)) + 'ada-when-indent))) + + ;;--------------------------- + ;; starting with t (then) + ;;--------------------------- + + ((and (= (downcase (char-after)) ?t) + (looking-at "then\\>")) + (if (save-excursion (ada-goto-previous-word) + (looking-at "and\\>")) + (ada-indent-on-previous-lines nil orgpoint orgpoint) + (save-excursion + ;; Select has been added for the statement: "select ... then abort" + (ada-search-ignore-string-comment + "\\<\\(elsif\\|if\\|select\\)\\>" t nil) + (list (progn (back-to-indentation) (point)) + 'ada-stmt-end-indent)))) + + ;;--------------------------- + ;; starting with l (loop) + ;;--------------------------- + + ((and (= (downcase (char-after)) ?l) + (looking-at "loop\\>")) + (setq pos (point)) + (save-excursion + (goto-char (match-end 0)) + (ada-goto-stmt-start) + (if (looking-at "\\<\\(loop\\|if\\)\\>") + (ada-indent-on-previous-lines nil orgpoint orgpoint) + (unless (looking-at ada-loop-start-re) + (ada-search-ignore-string-comment ada-loop-start-re + nil pos)) + (if (looking-at "\\") + (ada-indent-on-previous-lines nil orgpoint orgpoint) + (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent))))) + + ;;---------------------------- + ;; starting with l (limited) or r (record) + ;;---------------------------- + + ((or (and (= (downcase (char-after)) ?l) + (looking-at "limited\\>")) + (and (= (downcase (char-after)) ?r) + (looking-at "record\\>"))) + + (save-excursion + (ada-search-ignore-string-comment + "\\<\\(type\\|use\\)\\>" t nil) + (if (looking-at "\\") + (ada-search-ignore-string-comment "for" t nil nil + 'word-search-backward)) + (list (progn (back-to-indentation) (point)) + 'ada-indent-record-rel-type))) + + ;;--------------------------- + ;; starting with b (begin) + ;;--------------------------- + + ((and (= (downcase (char-after)) ?b) + (looking-at "begin\\>")) + (save-excursion + (if (ada-goto-decl-start t) + (list (progn (back-to-indentation) (point)) 0) + (ada-indent-on-previous-lines nil orgpoint orgpoint)))) + + ;;--------------------------- + ;; starting with i (is) + ;;--------------------------- + + ((and (= (downcase (char-after)) ?i) + (looking-at "is\\>")) + + (if (and ada-indent-is-separate + (save-excursion + (goto-char (match-end 0)) + (ada-goto-next-non-ws (point-at-eol)) + (looking-at "\\\\|\\"))) + (save-excursion + (ada-goto-stmt-start) + (list (progn (back-to-indentation) (point)) 'ada-indent)) + (save-excursion + (ada-goto-stmt-start) + (if (looking-at "\\") + (list (progn (back-to-indentation) (point)) 0) + (list (progn (back-to-indentation) (point)) 'ada-indent))))) + + ;;--------------------------- + ;; starting with r (return, renames) + ;;--------------------------- + + ((and (= (downcase (char-after)) ?r) + (looking-at "re\\(turn\\|names\\)\\>")) + + (save-excursion + (let ((var 'ada-indent-return)) + ;; If looking at a renames, skip the 'return' statement too + (if (looking-at "renames") + (let (pos) + (save-excursion + (setq pos (ada-search-ignore-string-comment ";\\|return\\>" t))) + (if (and pos + (= (downcase (char-after (car pos))) ?r)) + (goto-char (car pos))) + (setq var 'ada-indent-renames))) + + (forward-comment -1000) + (if (= (char-before) ?\)) + (forward-sexp -1) + (forward-word-strictly -1)) + + ;; If there is a parameter list, and we have a function declaration + ;; or access to subprogram declaration + (let ((num-back 1)) + (if (and (= (following-char) ?\() + (save-excursion + (or (progn + (backward-word-strictly 1) + (looking-at "\\(function\\|procedure\\)\\>")) + (progn + (backward-word-strictly 1) + (setq num-back 2) + (looking-at "\\(function\\|procedure\\)\\>"))))) + + ;; The indentation depends of the value of ada-indent-return + (if (<= (eval var) 0) + (list (point) (list '- var)) + (list (progn (backward-word-strictly num-back) (point)) + var)) + + ;; Else there is no parameter list, but we have a function + ;; Only do something special if the user want to indent + ;; relative to the "function" keyword + (if (and (> (eval var) 0) + (save-excursion (forward-word-strictly -1) + (looking-at "function\\>"))) + (list (progn (forward-word-strictly -1) (point)) var) + + ;; Else... + (ada-indent-on-previous-lines nil orgpoint orgpoint))))))) + + ;;-------------------------------- + ;; starting with 'o' or 'p' + ;; 'or' as statement-start + ;; 'private' as statement-start + ;;-------------------------------- + + ((and (or (= (downcase (char-after)) ?o) + (= (downcase (char-after)) ?p)) + (or (ada-looking-at-semi-or) + (ada-looking-at-semi-private))) + (save-excursion + ;; ??? Wasn't this done already in ada-looking-at-semi-or ? + (ada-goto-matching-start 1) + (list (progn (back-to-indentation) (point)) 0))) + + ;;-------------------------------- + ;; starting with 'd' (do) + ;;-------------------------------- + + ((and (= (downcase (char-after)) ?d) + (looking-at "do\\>")) + (save-excursion + (ada-goto-stmt-start) + (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent))) + + ;;-------------------------------- + ;; starting with '-' (comment) + ;;-------------------------------- + + ((= (char-after) ?-) + (if ada-indent-comment-as-code + + ;; Indent comments on previous line comments if required + ;; We must use a search-forward (even if the code is more complex), + ;; since we want to find the beginning of the comment. + (let (pos) + + (if (and ada-indent-align-comments + (save-excursion + (forward-line -1) + (beginning-of-line) + (while (and (not pos) + (search-forward "--" (point-at-eol) t)) + (unless (ada-in-string-p) + (setq pos (point)))) + pos)) + (list (- pos 2) 0) + + ;; Else always on previous line + (ada-indent-on-previous-lines nil orgpoint orgpoint))) + + ;; Else same indentation as the previous line + (list (save-excursion (back-to-indentation) (point)) 0))) + + ;;-------------------------------- + ;; starting with '#' (preprocessor line) + ;;-------------------------------- + + ((and (= (char-after) ?#) + (equal ada-which-compiler 'gnat) + (looking-at "#[ \t]*\\(if\\|els\\(e\\|if\\)\\|end[ \t]*if\\)")) + (list (point-at-bol) 0)) + + ;;-------------------------------- + ;; starting with ')' (end of a parameter list) + ;;-------------------------------- + + ((and (not (eobp)) (= (char-after) ?\))) + (save-excursion + (forward-char 1) + (backward-sexp 1) + (list (point) 0))) + + ;;--------------------------------- + ;; new/abstract/separate + ;;--------------------------------- + + ((looking-at "\\(new\\|abstract\\|separate\\)\\>") + (ada-indent-on-previous-lines nil orgpoint orgpoint)) + + ;;--------------------------------- + ;; package/function/procedure + ;;--------------------------------- + + ((and (or (= (downcase (char-after)) ?p) (= (downcase (char-after)) ?f)) + (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")) + (save-excursion + ;; Go up until we find either a generic section, or the end of the + ;; previous subprogram/package, or 'overriding' for this function/procedure + (let (found) + (while (and (not found) + (ada-search-ignore-string-comment + "\\<\\(generic\\|end\\|begin\\|overriding\\|package\\|procedure\\|function\\)\\>" t)) + + ;; avoid "with procedure"... in generic parts + (save-excursion + (forward-word-strictly -1) + (setq found (not (looking-at "with")))))) + + (cond + ((looking-at "\\") + (list (progn (back-to-indentation) (point)) 0)) + + (t + (ada-indent-on-previous-lines nil orgpoint orgpoint))))) + + ;;--------------------------------- + ;; label + ;;--------------------------------- + + ((looking-at ada-label-re) + (if (ada-in-decl-p) + ;; ada-block-label-re matches variable declarations + (ada-indent-on-previous-lines nil orgpoint orgpoint) + (append (ada-indent-on-previous-lines nil orgpoint orgpoint) + '(ada-label-indent)))) + + )) + + ;;--------------------------------- + ;; Other syntaxes + ;;--------------------------------- + (or result (ada-indent-on-previous-lines nil orgpoint orgpoint)))) + +(defun ada-indent-on-previous-lines (&optional nomove orgpoint initial-pos) + "Calculate the indentation for the new line after ORGPOINT. +The result list is based on the previous lines in the buffer. +If NOMOVE is nil, moves point to the beginning of the current statement. +if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation." + (if initial-pos + (goto-char initial-pos)) + (let ((oldpoint (point))) + + ;; Is inside a parameter-list ? + (if (ada-in-paramlist-p) + (ada-get-indent-paramlist) + + ;; Move to beginning of current statement. If already at a + ;; statement start, move to beginning of enclosing statement. + (unless nomove + (ada-goto-stmt-start t)) + + ;; no beginning found => don't change indentation + (if (and (eq oldpoint (point)) + (not nomove)) + (ada-get-indent-nochange) + + (cond + ;; + ((and + ada-indent-to-open-paren + (ada-in-open-paren-p)) + (ada-get-indent-open-paren)) + ;; + ((looking-at "end\\>") + (ada-get-indent-end orgpoint)) + ;; + ((looking-at ada-loop-start-re) + (ada-get-indent-loop orgpoint)) + ;; + ((looking-at ada-subprog-start-re) + (ada-get-indent-subprog orgpoint)) + ;; + ((looking-at ada-block-start-re) + (ada-get-indent-block-start orgpoint)) + ;; + ((looking-at ada-block-label-re) ; also variable declaration + (ada-get-indent-block-label orgpoint)) + ;; + ((looking-at ada-goto-label-re) + (ada-get-indent-goto-label orgpoint)) + ;; + ((looking-at "\\(sub\\)?type\\>") + (ada-get-indent-type orgpoint)) + ;; + ;; "then" has to be included in the case of "select...then abort" + ;; statements, since (goto-stmt-start) at the beginning of + ;; the current function would leave the cursor on that position + ((looking-at "\\(\\(els\\)?if\\>\\)\\|then abort\\>") + (ada-get-indent-if orgpoint)) + ;; + ((looking-at "case\\>") + (ada-get-indent-case orgpoint)) + ;; + ((looking-at "when\\>") + (ada-get-indent-when orgpoint)) + ;; + ((looking-at "separate\\>") + (ada-get-indent-nochange)) + ;; + ((looking-at "with\\>\\|use\\>") + ;; Are we still in that statement, or are we in fact looking at + ;; the previous one ? + (if (save-excursion (search-forward ";" oldpoint t)) + (list (progn (back-to-indentation) (point)) 0) + (list (point) (if (looking-at "with") + 'ada-with-indent + 'ada-use-indent)))) + ;; + (t + (ada-get-indent-noindent orgpoint))))) + )) + +(defun ada-get-indent-open-paren () + "Calculate the indentation when point is behind an unclosed parenthesis." + (list (ada-in-open-paren-p) 0)) + +(defun ada-get-indent-nochange () + "Return the current indentation of the previous line." + (save-excursion + (forward-line -1) + (back-to-indentation) + (list (point) 0))) + +(defun ada-get-indent-paramlist () + "Calculate the indentation when point is inside a parameter list." + (save-excursion + (ada-search-ignore-string-comment "[^ \t\n]" t nil t) + (cond + ;; in front of the first parameter + ((= (char-after) ?\() + (goto-char (match-end 0)) + (list (point) 0)) + + ;; in front of another parameter + ((= (char-after) ?\;) + (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) + (ada-goto-next-non-ws) + (list (point) 0)) + + ;; After an affectation (default parameter value in subprogram + ;; declaration) + ((and (= (following-char) ?=) (= (preceding-char) ?:)) + (back-to-indentation) + (list (point) 'ada-broken-indent)) + + ;; inside a parameter declaration + (t + (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) + (ada-goto-next-non-ws) + (list (point) 'ada-broken-indent))))) + +(defun ada-get-indent-end (orgpoint) + "Calculate the indentation when point is just before an end statement. +ORGPOINT is the limit position used in the calculation." + (let ((defun-name nil) + (indent nil)) + + ;; is the line already terminated by ';' ? + (if (save-excursion + (ada-search-ignore-string-comment ";" nil orgpoint nil + 'search-forward)) + + ;; yes, look what's following 'end' + (progn + (forward-word-strictly 1) + (ada-goto-next-non-ws) + (cond + ;; + ;; loop/select/if/case/return + ;; + ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|return\\)\\>") + (save-excursion (ada-check-matching-start (match-string 0))) + (list (save-excursion (back-to-indentation) (point)) 0)) + + ;; + ;; record + ;; + ((looking-at "\\") + (save-excursion + (ada-check-matching-start (match-string 0)) + ;; we are now looking at the matching "record" statement + (forward-word-strictly 1) + (ada-goto-stmt-start) + ;; now on the matching type declaration, or use clause + (unless (looking-at "\\(for\\|type\\)\\>") + (ada-search-ignore-string-comment "\\" t)) + (list (progn (back-to-indentation) (point)) 0))) + ;; + ;; a named block end + ;; + ((looking-at ada-ident-re) + (setq defun-name (match-string 0)) + (save-excursion + (ada-goto-matching-start 0) + (ada-check-defun-name defun-name)) + (list (progn (back-to-indentation) (point)) 0)) + ;; + ;; a block-end without name + ;; + ((= (char-after) ?\;) + (save-excursion + (ada-goto-matching-start 0) + (if (looking-at "\\") + (progn + (setq indent (list (point) 0)) + (if (ada-goto-decl-start t) + (list (progn (back-to-indentation) (point)) 0) + indent)) + (list (progn (back-to-indentation) (point)) 0) + ))) + ;; + ;; anything else - should maybe signal an error ? + ;; + (t + (list (save-excursion (back-to-indentation) (point)) + 'ada-broken-indent)))) + + (list (save-excursion (back-to-indentation) (point)) + 'ada-broken-indent)))) + +(defun ada-get-indent-case (orgpoint) + "Calculate the indentation when point is just before a case statement. +ORGPOINT is the limit position used in the calculation." + (let ((match-cons nil) + (opos (point))) + (cond + ;; + ;; case..is..when..=> + ;; + ((save-excursion + (setq match-cons (and + ;; the `=>' must be after the keyword `is'. + (ada-search-ignore-string-comment + "is" nil orgpoint nil 'word-search-forward) + (ada-search-ignore-string-comment + "[ \t\n]+=>" nil orgpoint)))) + (save-excursion + (goto-char (car match-cons)) + (unless (ada-search-ignore-string-comment "when" t opos) + (error "Missing `when' between `case' and `=>'")) + (list (save-excursion (back-to-indentation) (point)) 'ada-indent))) + ;; + ;; case..is..when + ;; + ((save-excursion + (setq match-cons (ada-search-ignore-string-comment + "when" nil orgpoint nil 'word-search-forward))) + (goto-char (cdr match-cons)) + (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)) + ;; + ;; case..is + ;; + ((save-excursion + (setq match-cons (ada-search-ignore-string-comment + "is" nil orgpoint nil 'word-search-forward))) + (list (save-excursion (back-to-indentation) (point)) 'ada-when-indent)) + ;; + ;; incomplete case + ;; + (t + (list (save-excursion (back-to-indentation) (point)) + 'ada-broken-indent))))) + +(defun ada-get-indent-when (orgpoint) + "Calculate the indentation when point is just before a when statement. +ORGPOINT is the limit position used in the calculation." + (let ((cur-indent (save-excursion (back-to-indentation) (point)))) + (if (ada-search-ignore-string-comment "[ \t\n]*=>" nil orgpoint) + (list cur-indent 'ada-indent) + (list cur-indent 'ada-broken-indent)))) + +(defun ada-get-indent-if (orgpoint) + "Calculate the indentation when point is just before an if statement. +ORGPOINT is the limit position used in the calculation." + (let ((cur-indent (save-excursion (back-to-indentation) (point))) + (match-cons nil)) + ;; + ;; Move to the correct then (ignore all "and then") + ;; + (while (and (setq match-cons (ada-search-ignore-string-comment + "\\<\\(then\\|and[ \t]*then\\)\\>" + nil orgpoint)) + (= (downcase (char-after (car match-cons))) ?a))) + ;; If "then" was found (we are looking at it) + (if match-cons + (progn + ;; + ;; 'then' first in separate line ? + ;; => indent according to 'then', + ;; => else indent according to 'if' + ;; + (if (save-excursion + (back-to-indentation) + (looking-at "\\")) + (setq cur-indent (save-excursion (back-to-indentation) (point)))) + ;; skip 'then' + (forward-word-strictly 1) + (list cur-indent 'ada-indent)) + + (list cur-indent 'ada-broken-indent)))) + +(defun ada-get-indent-block-start (orgpoint) + "Calculate the indentation when point is at the start of a block. +ORGPOINT is the limit position used in the calculation." + (let ((pos nil)) + (cond + ((save-excursion + (forward-word-strictly 1) + (setq pos (ada-goto-next-non-ws orgpoint))) + (goto-char pos) + (save-excursion + (ada-indent-on-previous-lines t orgpoint))) + + ;; Special case for record types, for instance for: + ;; type A is (B : Integer; + ;; C : Integer) is record + ;; null; -- This is badly indented otherwise + ((looking-at "record") + + ;; If record is at the beginning of the line, indent from there + (if (save-excursion + (beginning-of-line) + (looking-at "^[ \t]*\\(record\\|limited record\\)")) + (list (save-excursion (back-to-indentation) (point)) 'ada-indent) + + ;; else indent relative to the type command + (list (save-excursion + (car (ada-search-ignore-string-comment "\\" t))) + 'ada-indent))) + + ;; Special case for label: + ((looking-at ada-block-label-re) + (list (- (save-excursion (back-to-indentation) (point)) ada-label-indent) 'ada-indent)) + + ;; nothing follows the block-start + (t + (list (save-excursion (back-to-indentation) (point)) 'ada-indent))))) + +(defun ada-get-indent-subprog (orgpoint) + "Calculate the indentation when point is just before a subprogram. +ORGPOINT is the limit position used in the calculation." + (let ((match-cons nil) + (cur-indent (save-excursion (back-to-indentation) (point))) + (foundis nil)) + ;; + ;; is there an 'is' in front of point ? + ;; + (if (save-excursion + (setq match-cons + (ada-search-ignore-string-comment + "\\<\\(is\\|do\\)\\>" nil orgpoint))) + ;; + ;; yes, then skip to its end + ;; + (progn + (setq foundis t) + (goto-char (cdr match-cons))) + ;; + ;; no, then goto next non-ws, if there is one in front of point + ;; + (progn + (unless (ada-goto-next-non-ws orgpoint) + (goto-char orgpoint)))) + + (cond + ;; + ;; nothing follows 'is' + ;; + ((and + foundis + (save-excursion + (not (ada-search-ignore-string-comment + "[^ \t\n]" nil orgpoint t)))) + (list cur-indent 'ada-indent)) + ;; + ;; is abstract/separate/new ... + ;; + ((and + foundis + (save-excursion + (setq match-cons + (ada-search-ignore-string-comment + "\\<\\(separate\\|new\\|abstract\\)\\>" + nil orgpoint)))) + (goto-char (car match-cons)) + (ada-search-ignore-string-comment ada-subprog-start-re t) + (ada-get-indent-noindent orgpoint)) + ;; + ;; something follows 'is' + ;; + ((and + foundis + (save-excursion (setq match-cons (ada-goto-next-non-ws orgpoint))) + (goto-char match-cons) + (ada-indent-on-previous-lines t orgpoint))) + ;; + ;; no 'is' but ';' + ;; + ((save-excursion + (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward)) + (list cur-indent 0)) + ;; + ;; no 'is' or ';' + ;; + (t + (list cur-indent 'ada-broken-indent))))) + +(defun ada-get-indent-noindent (orgpoint) + "Calculate the indentation when point is just before a `noindent stmt'. +ORGPOINT is the limit position used in the calculation." + (let ((label 0)) + (save-excursion + (beginning-of-line) + + (cond + + ;; This one is called when indenting a line preceded by a multi-line + ;; subprogram declaration (in that case, we are at this point inside + ;; the parameter declaration list) + ((ada-in-paramlist-p) + (ada-previous-procedure) + (list (save-excursion (back-to-indentation) (point)) 0)) + + ;; This one is called when indenting the second line of a multi-line + ;; declaration section, in a declare block or a record declaration + ((looking-at "[ \t]*\\(\\sw\\|_\\)*[ \t]*,[ \t]*$") + (list (save-excursion (back-to-indentation) (point)) + 'ada-broken-decl-indent)) + + ;; This one is called in every other case when indenting a line at the + ;; top level + (t + (if (looking-at (concat "[ \t]*" ada-block-label-re)) + (setq label (- ada-label-indent)) + + (let (p) + + ;; "with private" or "null record" cases + (if (or (save-excursion + (and (ada-search-ignore-string-comment "\\" nil orgpoint) + (setq p (point)) + (save-excursion (forward-char -7);; skip back "private" + (ada-goto-previous-word) + (looking-at "with")))) + (save-excursion + (and (ada-search-ignore-string-comment "\\" nil orgpoint) + (setq p (point)) + (save-excursion (forward-char -6);; skip back "record" + (ada-goto-previous-word) + (looking-at "null"))))) + (progn + (goto-char p) + (re-search-backward "\\<\\(type\\|subtype\\)\\>" nil t) + (list (save-excursion (back-to-indentation) (point)) 0))))) + (if (save-excursion + (ada-search-ignore-string-comment ";" nil orgpoint nil + 'search-forward)) + (list (+ (save-excursion (back-to-indentation) (point)) label) 0) + (list (+ (save-excursion (back-to-indentation) (point)) label) + 'ada-broken-indent))))))) + +(defun ada-get-indent-block-label (orgpoint) + "Calculate the indentation when before a label or variable declaration. +ORGPOINT is the limit position used in the calculation." + (let ((match-cons nil) + (cur-indent (save-excursion (back-to-indentation) (point)))) + (ada-search-ignore-string-comment ":" nil) + (cond + ;; loop label + ((save-excursion + (setq match-cons (ada-search-ignore-string-comment + ada-loop-start-re nil orgpoint))) + (goto-char (car match-cons)) + (ada-get-indent-loop orgpoint)) + + ;; declare label + ((save-excursion + (setq match-cons (ada-search-ignore-string-comment + "\\" nil orgpoint))) + (goto-char (car match-cons)) + (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) + + ;; variable declaration + ((ada-in-decl-p) + (if (save-excursion + (ada-search-ignore-string-comment ";" nil orgpoint)) + (list cur-indent 0) + (list cur-indent 'ada-broken-indent))) + + ;; nothing follows colon + (t + (list cur-indent '(- ada-label-indent)))))) + +(defun ada-get-indent-goto-label (orgpoint) + "Calculate the indentation when at a goto label." + (search-forward ">>") + (ada-goto-next-non-ws) + (if (>= (point) orgpoint) + ;; labeled statement is the one we need to indent + (list (- (point) ada-label-indent)) + ;; else indentation is indent for labeled statement + (ada-indent-on-previous-lines t orgpoint))) + +(defun ada-get-indent-loop (orgpoint) + "Calculate the indentation when just before a loop or a for ... use. +ORGPOINT is the limit position used in the calculation." + (let ((match-cons nil) + (pos (point)) + + ;; If looking at a named block, skip the label + (label (save-excursion + (back-to-indentation) + (if (looking-at ada-block-label-re) + (- ada-label-indent) + 0)))) + + (cond + + ;; + ;; statement complete + ;; + ((save-excursion + (ada-search-ignore-string-comment ";" nil orgpoint nil + 'search-forward)) + (list (+ (save-excursion (back-to-indentation) (point)) label) 0)) + ;; + ;; simple loop + ;; + ((looking-at "loop\\>") + (setq pos (ada-get-indent-block-start orgpoint)) + (if (equal label 0) + pos + (list (+ (car pos) label) (cadr pos)))) + + ;; + ;; 'for'- loop (or also a for ... use statement) + ;; + ((looking-at "for\\>") + (cond + ;; + ;; for ... use + ;; + ((save-excursion + (and + (goto-char (match-end 0)) + (ada-goto-next-non-ws orgpoint) + (forward-word-strictly 1) + (if (= (char-after) ?') (forward-word-strictly 1) t) + (ada-goto-next-non-ws orgpoint) + (looking-at "\\") + ;; + ;; check if there is a 'record' before point + ;; + (progn + (setq match-cons (ada-search-ignore-string-comment + "record" nil orgpoint nil 'word-search-forward)) + t))) + (if match-cons + (progn + (goto-char (car match-cons)) + (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) + (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)) + ) + + ;; + ;; for..loop + ;; + ((save-excursion + (setq match-cons (ada-search-ignore-string-comment + "loop" nil orgpoint nil 'word-search-forward))) + (goto-char (car match-cons)) + ;; + ;; indent according to 'loop', if it's first in the line; + ;; otherwise to 'for' + ;; + (unless (save-excursion + (back-to-indentation) + (looking-at "\\")) + (goto-char pos)) + (list (+ (save-excursion (back-to-indentation) (point)) label) + 'ada-indent)) + ;; + ;; for-statement is broken + ;; + (t + (list (+ (save-excursion (back-to-indentation) (point)) label) + 'ada-broken-indent)))) + + ;; + ;; 'while'-loop + ;; + ((looking-at "while\\>") + ;; + ;; while..loop ? + ;; + (if (save-excursion + (setq match-cons (ada-search-ignore-string-comment + "loop" nil orgpoint nil 'word-search-forward))) + + (progn + (goto-char (car match-cons)) + ;; + ;; indent according to 'loop', if it's first in the line; + ;; otherwise to 'while'. + ;; + (unless (save-excursion + (back-to-indentation) + (looking-at "\\")) + (goto-char pos)) + (list (+ (save-excursion (back-to-indentation) (point)) label) + 'ada-indent)) + + (list (+ (save-excursion (back-to-indentation) (point)) label) + 'ada-broken-indent)))))) + +(defun ada-get-indent-type (orgpoint) + "Calculate the indentation when before a type statement. +ORGPOINT is the limit position used in the calculation." + (let ((match-dat nil)) + (cond + ;; + ;; complete record declaration + ;; + ((save-excursion + (and + (setq match-dat (ada-search-ignore-string-comment + "end" nil orgpoint nil 'word-search-forward)) + (ada-goto-next-non-ws) + (looking-at "\\") + (forward-word-strictly 1) + (ada-goto-next-non-ws) + (= (char-after) ?\;))) + (goto-char (car match-dat)) + (list (save-excursion (back-to-indentation) (point)) 0)) + ;; + ;; record type + ;; + ((save-excursion + (setq match-dat (ada-search-ignore-string-comment + "record" nil orgpoint nil 'word-search-forward))) + (goto-char (car match-dat)) + (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) + ;; + ;; complete type declaration + ;; + ((save-excursion + (ada-search-ignore-string-comment ";" nil orgpoint nil + 'search-forward)) + (list (save-excursion (back-to-indentation) (point)) 0)) + ;; + ;; "type ... is", but not "type ... is ...", which is broken + ;; + ((save-excursion + (and + (ada-search-ignore-string-comment "is" nil orgpoint nil + 'word-search-forward) + (not (ada-goto-next-non-ws orgpoint)))) + (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)) + ;; + ;; broken statement + ;; + (t + (list (save-excursion (back-to-indentation) (point)) + 'ada-broken-indent))))) + + +;; ----------------------------------------------------------- +;; -- searching and matching +;; ----------------------------------------------------------- + +(defun ada-goto-stmt-start (&optional ignore-goto-label) + "Move point to the beginning of the statement that point is in or after. +Return the new position of point. +As a special case, if we are looking at a closing parenthesis, skip to the +open parenthesis." + (let ((match-dat nil) + (orgpoint (point))) + + (setq match-dat (ada-search-prev-end-stmt)) + (if match-dat + + ;; + ;; found a previous end-statement => check if anything follows + ;; + (unless (looking-at "declare") + (progn + (unless (save-excursion + (goto-char (cdr match-dat)) + (ada-goto-next-non-ws orgpoint ignore-goto-label)) + ;; + ;; nothing follows => it's the end-statement directly in + ;; front of point => search again + ;; + (setq match-dat (ada-search-prev-end-stmt))) + ;; + ;; if found the correct end-statement => goto next non-ws + ;; + (if match-dat + (goto-char (cdr match-dat))) + (ada-goto-next-non-ws) + )) + + ;; + ;; no previous end-statement => we are at the beginning of the + ;; accessible part of the buffer + ;; + (progn + (goto-char (point-min)) + ;; + ;; skip to the very first statement, if there is one + ;; + (unless (ada-goto-next-non-ws orgpoint) + (goto-char orgpoint)))) + (point))) + + +(defun ada-search-prev-end-stmt () + "Move point to previous end statement. +Return a cons cell whose car is the beginning and whose cdr +is the end of the match." + (let ((match-dat nil) + (found nil)) + + ;; search until found or beginning-of-buffer + (while + (and + (not found) + (setq match-dat (ada-search-ignore-string-comment + ada-end-stmt-re t))) + + (goto-char (car match-dat)) + (unless (ada-in-open-paren-p) + (cond + + ((and (looking-at + "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>") + (save-excursion + (ada-goto-previous-word) + (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]"))) + (forward-word-strictly -1)) + + ((looking-at "is") + (setq found + (and (save-excursion (ada-goto-previous-word) + (ada-goto-previous-word) + (not (looking-at "subtype"))) + + (save-excursion (goto-char (cdr match-dat)) + (ada-goto-next-non-ws) + ;; words that can go after an 'is' + (not (looking-at + (eval-when-compile + (concat "\\<" + (regexp-opt + '("separate" "access" "array" + "private" "abstract" "new") t) + "\\>\\|(")))))))) + + ((looking-at "private") + (save-excursion + (backward-word-strictly 1) + (setq found (not (looking-at "is"))))) + + (t + (setq found t)) + ))) + + (if found + match-dat + nil))) + +(defun ada-goto-next-non-ws (&optional limit skip-goto-label) + "Skip to next non-whitespace character. +Skips spaces, newlines and comments, and possibly goto labels. +Return `point' if moved, nil if not. +Stop the search at LIMIT. +Do not call this function from within a string." + (unless limit + (setq limit (point-max))) + (while (and (<= (point) limit) + (or (progn (forward-comment 10000) + (if (and (not (eobp)) + (save-excursion (forward-char 1) + (ada-in-string-p))) + (progn (forward-sexp 1) t))) + (and skip-goto-label + (looking-at ada-goto-label-re) + (progn + (goto-char (match-end 0)) + t))))) + (if (< (point) limit) + (point) + nil) + ) + + +(defun ada-goto-stmt-end (&optional limit) + "Move point to the end of the statement that point is in or before. +Return the new position of point or nil if not found. +Stop the search at LIMIT." + (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit) + (point) + nil)) + + +(defun ada-goto-next-word (&optional backward) + "Move point to the beginning of the next word of Ada code. +If BACKWARD is non-nil, jump to the beginning of the previous word. +Return the new position of point or nil if not found." + (let ((match-cons nil) + (orgpoint (point))) + (unless backward + (skip-syntax-forward "w_")) + (if (setq match-cons + (ada-search-ignore-string-comment "\\sw\\|\\s_" backward nil t)) + ;; + ;; move to the beginning of the word found + ;; + (progn + (goto-char (car match-cons)) + (skip-syntax-backward "w_") + (point)) + ;; + ;; if not found, restore old position of point + ;; + (goto-char orgpoint) + 'nil))) + + +(defun ada-check-matching-start (keyword) + "Signal an error if matching block start is not KEYWORD. +Moves point to the matching block start." + (ada-goto-matching-start 0) + (unless (looking-at (concat "\\<" keyword "\\>")) + (error "Matching start is not `%s'" keyword))) + + +(defun ada-check-defun-name (defun-name) + "Check if the name of the matching defun really is DEFUN-NAME. +Assumes point to be already positioned by `ada-goto-matching-start'. +Moves point to the beginning of the declaration." + + ;; named block without a `declare'; ada-goto-matching-start leaves + ;; point at start of 'begin' for a block. + (if (save-excursion + (ada-goto-previous-word) + (looking-at (concat "\\<" defun-name "\\> *:"))) + t ; name matches + ;; else + ;; + ;; 'accept' or 'package' ? + ;; + (unless (looking-at ada-subprog-start-re) + (ada-goto-decl-start)) + ;; + ;; 'begin' of 'procedure'/'function'/'task' or 'declare' + ;; + (save-excursion + ;; + ;; a named 'declare'-block ? => jump to the label + ;; + (if (looking-at "\\") + (progn + (forward-comment -1) + (backward-word-strictly 1)) + ;; + ;; no, => 'procedure'/'function'/'task'/'protected' + ;; + (progn + (forward-word-strictly 2) + (backward-word-strictly 1) + ;; + ;; skip 'body' 'type' + ;; + (if (looking-at "\\<\\(body\\|type\\)\\>") + (forward-word-strictly 1)) + (forward-sexp 1) + (backward-sexp 1))) + ;; + ;; should be looking-at the correct name + ;; + (unless (looking-at (concat "\\<" defun-name "\\>")) + (error "Matching defun has different name: %s" + (buffer-substring (point) + (progn (forward-sexp 1) (point)))))))) + +(defun ada-goto-decl-start (&optional noerror) + "Move point to the declaration start of the current construct. +If NOERROR is non-nil, return nil if no match was found; +otherwise throw error." + (let ((nest-count 1) + (regexp (eval-when-compile + (concat "\\<" + (regexp-opt + '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t) + "\\>"))) + + ;; first should be set to t if we should stop at the first + ;; "begin" we encounter. + (first t) + (count-generic nil) + (stop-at-when nil) + ) + + ;; Ignore "when" most of the time, except if we are looking at the + ;; beginning of a block (structure: case .. is + ;; when ... => + ;; begin ... + ;; exception ... ) + (if (looking-at "begin") + (setq stop-at-when t)) + + (if (or + (looking-at "\\<\\(package\\|procedure\\|function\\)\\>") + (save-excursion + (ada-search-ignore-string-comment + "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t) + (looking-at "generic"))) + (setq count-generic t)) + + ;; search backward for interesting keywords + (while (and + (not (zerop nest-count)) + (ada-search-ignore-string-comment regexp t)) + ;; + ;; calculate nest-depth + ;; + (cond + ;; + ((looking-at "end") + (ada-goto-matching-start 1 noerror) + + ;; In some case, two begin..end block can follow each other closely, + ;; which we have to detect, as in + ;; procedure P is + ;; procedure Q is + ;; begin + ;; end; + ;; begin -- here we should go to procedure, not begin + ;; end + + (if (looking-at "begin") + (let ((loop-again t)) + (save-excursion + (while loop-again + ;; If begin was just there as the beginning of a block + ;; (with no declare) then do nothing, otherwise just + ;; register that we have to find the statement that + ;; required the begin + + (ada-search-ignore-string-comment + "\\<\\(declare\\|begin\\|end\\|procedure\\|function\\|task\\|package\\)\\>" + t) + + (if (looking-at "end") + (ada-goto-matching-start 1 noerror t) + + (setq loop-again nil) + (unless (looking-at "begin") + (setq nest-count (1+ nest-count)))) + )) + ))) + ;; + ((looking-at "generic") + (if count-generic + (progn + (setq first nil) + (setq nest-count (1- nest-count))))) + ;; + ((looking-at "if") + (save-excursion + (forward-word-strictly -1) + (unless (looking-at "\\") + (progn + (setq nest-count (1- nest-count)) + (setq first nil))))) + + ;; + ((looking-at "declare\\|generic") + (setq nest-count (1- nest-count)) + (setq first t)) + ;; + ((looking-at "is") + ;; look for things to ignore + (if + (or + ;; generic formal parameter + (looking-at "is[ t]+<>") + + ;; A type definition, or a case statement. Note that the + ;; goto-matching-start above on 'end record' leaves us at + ;; 'record', not at 'type'. + ;; + ;; We get to a case statement here by calling + ;; 'ada-move-to-end' from inside a case statement; then + ;; we are not ignoring 'when'. + (save-excursion + ;; Skip type discriminants or case argument function call param list + (forward-comment -10000) + (forward-char -1) + (if (= (char-after) ?\)) + (progn + (forward-char 1) + (backward-sexp 1) + (forward-comment -10000) + )) + ;; skip type or case argument name + (skip-chars-backward "a-zA-Z0-9_.'") + (ada-goto-previous-word) + (and + ;; if it's a protected type, it's the decl start we + ;; are looking for; since we didn't see the 'end' + ;; above, we are inside it. + (looking-at "\\<\\(sub\\)?type\\|case\\>") + (save-match-data + (ada-goto-previous-word) + (not (looking-at "\\")))) + ) ; end of type definition p + + ;; null procedure declaration + (save-excursion (ada-goto-next-word) (looking-at "\\")) + );; end or + ;; skip this construct + nil + ;; this is the right "is" + (setq nest-count (1- nest-count)) + (setq first nil))) + + ;; + ((looking-at "new") + (if (save-excursion + (ada-goto-previous-word) + (looking-at "is")) + (goto-char (match-beginning 0)))) + ;; + ((and first + (looking-at "begin")) + (setq nest-count 0)) + ;; + ((looking-at "when") + (save-excursion + (forward-word-strictly -1) + (unless (looking-at "\\") + (progn + (if stop-at-when + (setq nest-count (1- nest-count))) + )))) + ;; + ((looking-at "begin") + (setq first nil)) + ;; + (t + (setq nest-count (1+ nest-count)) + (setq first nil))) + + );; end of loop + + ;; check if declaration-start is really found + (if (and + (zerop nest-count) + (if (looking-at "is") + (ada-search-ignore-string-comment ada-subprog-start-re t) + (looking-at "declare\\|generic"))) + t + (if noerror nil + (error "No matching proc/func/task/declare/package/protected"))) + )) + +(defun ada-goto-matching-start (&optional nest-level noerror gotothen) + "Move point to the beginning of a block-start. +Which block depends on the value of NEST-LEVEL, which defaults to zero. +If NOERROR is non-nil, it only returns nil if no matching start was found. +If GOTOTHEN is non-nil, point moves to the `then' following `if'." + (let ((nest-count (if nest-level nest-level 0)) + (found nil) + + (last-was-begin '()) + ;; List all keywords encountered while traversing + ;; something like '("end" "end" "begin") + ;; This is removed from the list when "package", "procedure",... + ;; are seen. The goal is to find whether a package has an elaboration + ;; part + + (pos nil)) + + ;; search backward for interesting keywords + (while (and + (not found) + (ada-search-ignore-string-comment ada-matching-start-re t)) + + (unless (and (looking-at "\\") + (save-excursion + (forward-word-strictly -1) + (looking-at "\\"))) + (progn + ;; calculate nest-depth + (cond + ;; found block end => increase nest depth + ((looking-at "end") + (push nil last-was-begin) + (setq nest-count (1+ nest-count))) + + ;; found loop/select/record/case/if => check if it starts or + ;; ends a block + ((looking-at "loop\\|select\\|record\\|case\\|if") + (setq pos (point)) + (save-excursion + ;; check if keyword follows 'end' + (ada-goto-previous-word) + (if (looking-at "\\[ \t]*[^;]") + (progn + ;; it ends a block => increase nest depth + (setq nest-count (1+ nest-count) + pos (point)) + (push nil last-was-begin)) + + ;; it starts a block => decrease nest depth + (setq nest-count (1- nest-count)) + + ;; Some nested "begin .. end" blocks with no "declare"? + ;; => remove those entries + (while (car last-was-begin) + (setq last-was-begin (cdr (cdr last-was-begin)))) + + (setq last-was-begin (cdr last-was-begin)) + )) + (goto-char pos) + ) + + ;; found package start => check if it really is a block + ((looking-at "package") + (save-excursion + ;; ignore if this is just a renames statement + (let ((current (point)) + (pos (ada-search-ignore-string-comment + "\\<\\(is\\|renames\\|;\\)\\>" nil))) + (if pos + (goto-char (car pos)) + (error (concat + "No matching `is' or `renames' for `package' at" + " line " + (number-to-string (count-lines 1 (1+ current))))))) + (unless (looking-at "renames") + (progn + (forward-word-strictly 1) + (ada-goto-next-non-ws) + ;; ignore it if it is only a declaration with 'new' + ;; We could have package Foo is new .... + ;; or package Foo is separate; + ;; or package Foo is begin null; end Foo + ;; for elaboration code (elaboration) + (if (and (not (looking-at "\\<\\(new\\|separate\\|begin\\)\\>")) + (not (car last-was-begin))) + (setq nest-count (1- nest-count)))))) + + (setq last-was-begin (cdr last-was-begin)) + ) + ;; found task start => check if it has a body + ((looking-at "task") + (save-excursion + (forward-word-strictly 1) + (ada-goto-next-non-ws) + (cond + ((looking-at "\\")) + ((looking-at "\\") + ;; In that case, do nothing if there is a "is" + (forward-word-strictly 2);; skip "type" + (ada-goto-next-non-ws);; skip type name + + ;; Do nothing if we are simply looking at a simple + ;; "task type name;" statement with no block + (unless (looking-at ";") + (progn + ;; Skip the parameters + (if (looking-at "(") + (ada-search-ignore-string-comment ")" nil)) + (let ((tmp (ada-search-ignore-string-comment + "\\<\\(is\\|;\\)\\>" nil))) + (if tmp + (progn + (goto-char (car tmp)) + (if (looking-at "is") + (setq nest-count (1- nest-count))))))))) + (t + ;; Check if that task declaration had a block attached to + ;; it (i.e do nothing if we have just "task name;") + (unless (progn (forward-word-strictly 1) + (looking-at "[ \t]*;")) + (setq nest-count (1- nest-count)))))) + (setq last-was-begin (cdr last-was-begin)) + ) + + ((looking-at "declare") + ;; remove entry for begin and end (include nested begin..end + ;; groups) + (setq last-was-begin (cdr last-was-begin)) + (let ((count 1)) + (while (and (> count 0)) + (if (equal (car last-was-begin) t) + (setq count (1+ count)) + (setq count (1- count))) + (setq last-was-begin (cdr last-was-begin)) + ))) + + ((looking-at "protected") + ;; Ignore if this is just a declaration + (save-excursion + (let ((pos (ada-search-ignore-string-comment + "\\(\\\\|\\\\|;\\)" nil))) + (if pos + (goto-char (car pos))) + (if (looking-at "is") + ;; remove entry for end + (setq last-was-begin (cdr last-was-begin))))) + (setq nest-count (1- nest-count))) + + ((or (looking-at "procedure") + (looking-at "function")) + ;; Ignore if this is just a declaration + (save-excursion + (let ((pos (ada-search-ignore-string-comment + "\\(\\\\|\\\\|)[ \t]*;\\)" nil))) + (if pos + (goto-char (car pos))) + (if (looking-at "is") + ;; remove entry for begin and end + (setq last-was-begin (cdr (cdr last-was-begin)))))) + ) + + ;; all the other block starts + (t + (push (looking-at "begin") last-was-begin) + (setq nest-count (1- nest-count))) + + ) + + ;; match is found, if nest-depth is zero + (setq found (zerop nest-count))))) ; end of loop + + (if (bobp) + (point) + (if found + ;; + ;; match found => is there anything else to do ? + ;; + (progn + (cond + ;; + ;; found 'if' => skip to 'then', if it's on a separate line + ;; and GOTOTHEN is non-nil + ;; + ((and + gotothen + (looking-at "if") + (save-excursion + (ada-search-ignore-string-comment "then" nil nil nil + 'word-search-forward) + (back-to-indentation) + (looking-at "\\"))) + (goto-char (match-beginning 0))) + + ;; + ;; found 'do' => skip back to 'accept' or 'return' + ;; + ((looking-at "do") + (unless (ada-search-ignore-string-comment + "\\" t) + (error "Missing `accept' or `return' in front of `do'")))) + (point)) + + (if noerror + nil + (error "No matching start")))))) + + +(defun ada-goto-matching-end (&optional nest-level noerror) + "Move point to the end of a block. +Which block depends on the value of NEST-LEVEL, which defaults to zero. +If NOERROR is non-nil, it only returns nil if no matching start found." + (let ((nest-count (or nest-level 0)) + (regex (eval-when-compile + (concat "\\<" + (regexp-opt '("end" "loop" "select" "begin" "case" + "if" "task" "package" "record" "do" + "procedure" "function") t) + "\\>"))) + found + pos + + ;; First is used for subprograms: they are generally handled + ;; recursively, but of course we do not want to do that the + ;; first time (see comment below about subprograms) + (first (not (looking-at "declare")))) + + ;; If we are already looking at one of the keywords, this shouldn't count + ;; in the nesting loop below, so we just make sure we don't count it. + ;; "declare" is a special case because we need to look after the "begin" + ;; keyword + (if (looking-at "\\") + (forward-char 1)) + + ;; + ;; search forward for interesting keywords + ;; + (while (and + (not found) + (ada-search-ignore-string-comment regex nil)) + + ;; + ;; calculate nest-depth + ;; + (backward-word-strictly 1) + (cond + ;; procedures and functions need to be processed recursively, in + ;; case they are defined in a declare/begin block, as in: + ;; declare -- NL 0 (nested level) + ;; A : Boolean; + ;; procedure B (C : D) is + ;; begin -- NL 1 + ;; null; + ;; end B; -- NL 0, and we would exit + ;; begin + ;; end; -- we should exit here + ;; processing them recursively avoids the need for any special + ;; handling. + ;; Nothing should be done if we have only the specs or a + ;; generic instantiation. + + ((and (looking-at "\\")) + (if first + (forward-word-strictly 1) + + (setq pos (point)) + (ada-search-ignore-string-comment "is\\|;") + (if (= (char-before) ?s) + (progn + (ada-goto-next-non-ws) + (unless (looking-at "\\") + (progn + (goto-char pos) + (ada-goto-matching-end 0 t))))))) + + ;; found block end => decrease nest depth + ((looking-at "\\") + (setq nest-count (1- nest-count) + found (<= nest-count 0)) + ;; skip the following keyword + (if (progn + (skip-chars-forward "end") + (ada-goto-next-non-ws) + (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>")) + (forward-word-strictly 1))) + + ;; found package start => check if it really starts a block, and is not + ;; in fact a generic instantiation for instance + ((looking-at "\\") + (ada-search-ignore-string-comment "is" nil nil nil + 'word-search-forward) + (ada-goto-next-non-ws) + ;; ignore and skip it if it is only a 'new' package + (if (looking-at "\\") + (goto-char (match-end 0)) + (setq nest-count (1+ nest-count) + found (<= nest-count 0)))) + + ;; all the other block starts + (t + (if (not first) + (setq nest-count (1+ nest-count))) + (setq found (<= nest-count 0)) + (forward-word-strictly 1))) ; end of 'cond' + + (setq first nil)) + + (if found + t + (if noerror + nil + (error "No matching end"))) + )) + + +(defun ada-search-ignore-string-comment + (search-re &optional backward limit paramlists search-func) + "Regexp-search for SEARCH-RE, ignoring comments, strings. +Returns a cons cell of begin and end of match data or nil, if not found. +If BACKWARD is non-nil, search backward; search forward otherwise. +The search stops at pos LIMIT. +If PARAMLISTS is nil, ignore parameter lists. +The search is done using SEARCH-FUNC. SEARCH-FUNC can be optimized +in case we are searching for a constant string. +Point is moved at the beginning of the SEARCH-RE." + (let (found + begin + end + parse-result) + + ;; FIXME: need to pass BACKWARD to search-func! + (unless search-func + (setq search-func (if backward 're-search-backward 're-search-forward))) + + ;; + ;; search until found or end-of-buffer + ;; We have to test that we do not look further than limit + ;; + (with-syntax-table ada-mode-symbol-syntax-table + (while (and (not found) + (or (not limit) + (or (and backward (<= limit (point))) + (>= limit (point)))) + (funcall search-func search-re limit 1)) + (setq begin (match-beginning 0)) + (setq end (match-end 0)) + (setq parse-result (parse-partial-sexp (point-at-bol) (point))) + (cond + ;; + ;; If inside a string, skip it (and the following comments) + ;; + ((ada-in-string-p parse-result) + (if (featurep 'xemacs) + (search-backward "\"" nil t) + (goto-char (nth 8 parse-result))) + (unless backward (forward-sexp 1))) + ;; + ;; If inside a comment, skip it (and the following comments) + ;; There is a special code for comments at the end of the file + ;; + ((ada-in-comment-p parse-result) + (if (featurep 'xemacs) + (progn + (forward-line 1) + (beginning-of-line) + (forward-comment -1)) + (goto-char (nth 8 parse-result))) + (unless backward + ;; at the end of the file, it is not possible to skip a comment + ;; so we just go at the end of the line + (if (forward-comment 1) + (progn + (forward-comment 1000) + (beginning-of-line)) + (end-of-line)))) + ;; + ;; directly in front of a comment => skip it, if searching forward + ;; + ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-)) + (unless backward (progn (forward-char -1) (forward-comment 1000)))) + + ;; + ;; found a parameter-list but should ignore it => skip it + ;; + ((and (not paramlists) (ada-in-paramlist-p)) + (if backward + (search-backward "(" nil t) + (search-forward ")" nil t))) + ;; + ;; found what we were looking for + ;; + (t + (setq found t))))) ; end of loop + + (if found + (cons begin end) + nil))) + +;; ------------------------------------------------------- +;; -- Testing the position of the cursor +;; ------------------------------------------------------- + +(defun ada-in-decl-p () + "Return t if point is inside a declarative part. +Assumes point to be at the end of a statement." + (or (ada-in-paramlist-p) + (save-excursion + (ada-goto-decl-start t)))) + + +(defun ada-looking-at-semi-or () + "Return t if looking at an `or' following a semicolon." + (save-excursion + (and (looking-at "\\") + (progn + (forward-word-strictly 1) + (ada-goto-stmt-start) + (looking-at "\\"))))) + + +(defun ada-looking-at-semi-private () + "Return t if looking at the start of a private section in a package. +Return nil if the private is part of the package name, as in +'private package A is...' (this can only happen at top level)." + (save-excursion + (and (looking-at "\\") + (not (looking-at "\\")))))))) + + +(defun ada-in-paramlist-p () + "Return t if point is inside the parameter-list of a declaration, but not a subprogram call or aggregate." + (save-excursion + (and + (ada-search-ignore-string-comment "(\\|)" t nil t) + ;; inside parentheses ? + (= (char-after) ?\() + + ;; We could be looking at two things here: + ;; operator definition: function "." ( + ;; subprogram definition: procedure .... ( + ;; Let's skip back over the first one + (progn + (skip-chars-backward " \t\n") + (if (= (char-before) ?\") + (backward-char 3) + (backward-word-strictly 1)) + t) + + ;; and now over the second one + (backward-word-strictly 1) + + ;; We should ignore the case when the reserved keyword is in a + ;; comment (for instance, when we have: + ;; -- .... package + ;; Test (A) + ;; we should return nil + + (not (ada-in-string-or-comment-p)) + + ;; right keyword two words before parenthesis ? + ;; Type is in this list because of discriminants + ;; pragma is not, because the syntax is that of a subprogram call. + (looking-at (eval-when-compile + (concat "\\<\\(" + "procedure\\|function\\|body\\|" + "task\\|entry\\|accept\\|" + "access[ \t]+procedure\\|" + "access[ \t]+function\\|" + "type\\)\\>")))))) + +(defun ada-search-ignore-complex-boolean (regexp backwardp) + "Search for REGEXP, ignoring comments, strings, `and then', `or else'. +If BACKWARDP is non-nil, search backward; search forward otherwise." + (let (result) + (while (and (setq result (ada-search-ignore-string-comment regexp backwardp)) + (save-excursion (forward-word-strictly -1) + (looking-at "and then\\|or else")))) + result)) + +(defun ada-in-open-paren-p () + "Non-nil if in an open parenthesis. +Return value is the position of the first non-ws behind the last unclosed +parenthesis, or nil." + (save-excursion + (let ((parse (parse-partial-sexp + ;; In Emacs 28, TO has to be greater than FROM. + (or (car (ada-search-ignore-complex-boolean + "\\<\\(;\\|is\\|then\\|loop\\|begin\\|else\\)\\>" + t)) + (point-min)) + (point)))) + + (if (nth 1 parse) + (progn + (goto-char (1+ (nth 1 parse))) + + ;; Skip blanks, if they are not followed by a comment + ;; See: + ;; type A is ( Value_0, + ;; Value_1); + ;; type B is ( -- comment + ;; Value_2); + + (if (or (not ada-indent-handle-comment-special) + (not (looking-at "[ \t]+--"))) + (skip-chars-forward " \t")) + + (point)))))) + + +;; ----------------------------------------------------------- +;; -- Behavior Of TAB Key +;; ----------------------------------------------------------- + +(defun ada-tab () + "Do indenting or tabbing according to `ada-tab-policy'. +In Transient Mark mode, if the mark is active, operate on the contents +of the region. Otherwise, operate only on the current line." + (interactive) + (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard)) + ((eq ada-tab-policy 'indent-auto) + (if (ada-region-selected) + (ada-indent-region (region-beginning) (region-end)) + (ada-indent-current))) + ((eq ada-tab-policy 'always-tab) (error "Not implemented")) + )) + +(defun ada-untab (_arg) + "Delete leading indenting according to `ada-tab-policy'." + ;; FIXME: ARG is ignored + (interactive "P") + (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard)) + ((eq ada-tab-policy 'indent-auto) (error "Not implemented")) + ((eq ada-tab-policy 'always-tab) (error "Not implemented")) + )) + +(defun ada-indent-current-function () + "Ada mode version of the `indent-line-function'." + (interactive "*") + (let ((starting-point (point-marker))) + (beginning-of-line) + (ada-tab) + (if (< (point) starting-point) + (goto-char starting-point)) + (set-marker starting-point nil) + )) + +(defun ada-tab-hard () + "Indent current line to next tab stop." + (interactive) + (save-excursion + (beginning-of-line) + (insert-char ? ada-indent)) + (if (bolp) (forward-char ada-indent))) + +(defun ada-untab-hard () + "Indent current line to previous tab stop." + (interactive) + (indent-rigidly (point-at-bol) (point-at-eol) (- 0 ada-indent))) + + +;; ------------------------------------------------------------ +;; -- Miscellaneous +;; ------------------------------------------------------------ + +;; Not needed any more for Emacs 21.2, but still needed for backward +;; compatibility +(defun ada-remove-trailing-spaces () + "Remove trailing spaces in the whole buffer." + (interactive) + (save-match-data + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward "[ \t]+$" (point-max) t) + (replace-match "" nil nil)))))) + +(defun ada-gnat-style () + "Clean up comments, `(' and `,' for GNAT style checking switch." + (interactive) + (save-excursion + + ;; The \n is required, or the line after an empty comment line is + ;; simply ignored. + (goto-char (point-min)) + (while (re-search-forward "--[ \t]*\\([^-\n]\\)" nil t) + (replace-match "-- \\1") + (forward-line 1) + (beginning-of-line)) + + (goto-char (point-min)) + (while (re-search-forward "\\>(" nil t) + (if (not (ada-in-string-or-comment-p)) + (replace-match " ("))) + (goto-char (point-min)) + (while (re-search-forward ";--" nil t) + (forward-char -1) + (if (not (ada-in-string-or-comment-p)) + (replace-match "; --"))) + (goto-char (point-min)) + (while (re-search-forward "([ \t]+" nil t) + (if (not (ada-in-string-or-comment-p)) + (replace-match "("))) + (goto-char (point-min)) + (while (re-search-forward ")[ \t]+)" nil t) + (if (not (ada-in-string-or-comment-p)) + (replace-match "))"))) + (goto-char (point-min)) + (while (re-search-forward "\\>:" nil t) + (if (not (ada-in-string-or-comment-p)) + (replace-match " :"))) + + ;; Make sure there is a space after a ','. + ;; Always go back to the beginning of the match, since otherwise + ;; a statement like ('F','D','E') is incorrectly modified. + (goto-char (point-min)) + (while (re-search-forward ",[ \t]*\\(.\\)" nil t) + (if (not (save-excursion + (goto-char (match-beginning 0)) + (ada-in-string-or-comment-p))) + (replace-match ", \\1"))) + + ;; Operators should be surrounded by spaces. + (goto-char (point-min)) + (while (re-search-forward + "[ \t]*\\(/=\\|\\*\\*\\|:=\\|\\.\\.\\|[-:+*/]\\)[ \t]*" + nil t) + (goto-char (match-beginning 1)) + (if (or (looking-at "--") + (ada-in-string-or-comment-p)) + (progn + (forward-line 1) + (beginning-of-line)) + (cond + ((string= (match-string 1) "/=") + (replace-match " /= ")) + ((string= (match-string 1) "..") + (replace-match " .. ")) + ((string= (match-string 1) "**") + (replace-match " ** ")) + ((string= (match-string 1) ":=") + (replace-match " := ")) + (t + (replace-match " \\1 "))) + (forward-char 1))) + )) + + + +;; ------------------------------------------------------------- +;; -- Moving To Procedures/Packages/Statements +;; ------------------------------------------------------------- + +(defun ada-move-to-start () + "Move point to the matching start of the current Ada structure." + (interactive) + (let ((pos (point))) + (with-syntax-table ada-mode-symbol-syntax-table + + (save-excursion + ;; + ;; do nothing if in string or comment or not on 'end ...;' + ;; or if an error occurs during processing + ;; + (or + (ada-in-string-or-comment-p) + (and (progn + (or (looking-at "[ \t]*\\") + (backward-word-strictly 1)) + (or (looking-at "[ \t]*\\") + (backward-word-strictly 1)) + (or (looking-at "[ \t]*\\") + (error "Not on end ...;"))) + (ada-goto-matching-start 1) + (setq pos (point)) + + ;; + ;; on 'begin' => go on, according to user option + ;; + ada-move-to-declaration + (looking-at "\\") + (ada-goto-decl-start) + (setq pos (point)))) + + ) ; end of save-excursion + + ;; now really move to the found position + (goto-char pos)))) + +(defun ada-move-to-end () + "Move point to the end of the block around point. +Moves to `begin' if in a declarative part." + (interactive) + (let ((pos (point)) + decl-start) + (with-syntax-table ada-mode-symbol-syntax-table + + (save-excursion + + (cond + ;; Go to the beginning of the current word, and check if we are + ;; directly on 'begin' + ((save-excursion + (skip-syntax-backward "w") + (looking-at "\\")) + (ada-goto-matching-end 1)) + + ;; on first line of subprogram body + ;; Do nothing for specs or generic instantiation, since these are + ;; handled as the general case (find the enclosing block) + ;; We also need to make sure that we ignore nested subprograms + ((save-excursion + (and (skip-syntax-backward "w") + (looking-at "\\\\|\\" ) + (ada-search-ignore-string-comment "is\\|;") + (not (= (char-before) ?\;)) + )) + (skip-syntax-backward "w") + (ada-goto-matching-end 0 t)) + + ;; on first line of task declaration + ((save-excursion + (and (ada-goto-stmt-start) + (looking-at "\\" ) + (forward-word-strictly 1) + (ada-goto-next-non-ws) + (looking-at "\\"))) + (ada-search-ignore-string-comment "begin" nil nil nil + 'word-search-forward)) + ;; accept block start + ((save-excursion + (and (ada-goto-stmt-start) + (looking-at "\\" ))) + (ada-goto-matching-end 0)) + ;; package start + ((save-excursion + (setq decl-start (and (ada-goto-decl-start t) (point))) + (and decl-start (looking-at "\\"))) + (ada-goto-matching-end 1)) + + ;; On a "declare" keyword + ((save-excursion + (skip-syntax-backward "w") + (looking-at "\\")) + (ada-goto-matching-end 0 t)) + + ;; inside a 'begin' ... 'end' block + (decl-start + (goto-char decl-start) + (ada-goto-matching-end 0 t)) + + ;; (hopefully ;-) everything else + (t + (ada-goto-matching-end 1))) + (setq pos (point)) + ) + + ;; now really move to the position found + (goto-char pos)))) + +(defun ada-next-procedure () + "Move point to next procedure." + (interactive) + (end-of-line) + (if (re-search-forward ada-procedure-start-regexp nil t) + (goto-char (match-beginning 4)) + (error "No more functions/procedures/tasks"))) + +(defun ada-previous-procedure () + "Move point to previous procedure." + (interactive) + (beginning-of-line) + (if (re-search-backward ada-procedure-start-regexp nil t) + (goto-char (match-beginning 4)) + (error "No more functions/procedures/tasks"))) + +(defun ada-next-package () + "Move point to next package." + (interactive) + (end-of-line) + (if (re-search-forward ada-package-start-regexp nil t) + (goto-char (match-beginning 1)) + (error "No more packages"))) + +(defun ada-previous-package () + "Move point to previous package." + (interactive) + (beginning-of-line) + (if (re-search-backward ada-package-start-regexp nil t) + (goto-char (match-beginning 1)) + (error "No more packages"))) + + +;; ------------------------------------------------------------ +;; -- Define keymap and menus for Ada +;; ------------------------------------------------------------- + +(defun ada-create-keymap () + "Create the keymap associated with the Ada mode." + + ;; All non-standard keys go into ada-mode-extra-map + (define-key ada-mode-map ada-mode-extra-prefix ada-mode-extra-map) + + ;; Indentation and Formatting + (define-key ada-mode-map "\C-j" 'ada-indent-newline-indent-conditional) + (define-key ada-mode-map "\C-m" 'ada-indent-newline-indent-conditional) + (define-key ada-mode-map "\t" 'ada-tab) + (define-key ada-mode-map "\C-c\t" 'ada-justified-indent-current) + (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region) + (define-key ada-mode-map [(shift tab)] 'ada-untab) + (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist) + ;; We don't want to make meta-characters case-specific. + + ;; Movement + (define-key ada-mode-map "\M-\C-e" 'ada-next-procedure) + (define-key ada-mode-map "\M-\C-a" 'ada-previous-procedure) + (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start) + (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end) + + ;; Compilation + (unless (lookup-key ada-mode-map "\C-c\C-c") + (define-key ada-mode-map "\C-c\C-c" 'compile)) + + ;; Casing + (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer) + (define-key ada-mode-map "\C-c\C-t" 'ada-case-read-exceptions) + (define-key ada-mode-map "\C-c\C-y" 'ada-create-case-exception) + (define-key ada-mode-map "\C-c\C-\M-y" 'ada-create-case-exception-substring) + + ;; On XEmacs, you can easily specify whether DEL should deletes + ;; one character forward or one character backward. Take this into + ;; account + (define-key ada-mode-map + (if (boundp 'delete-key-deletes-forward) [backspace] "\177") + 'backward-delete-char-untabify) + + ;; Make body + (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body) + + ;; Use predefined function of Emacs19 for comments (RE) + ;; FIXME: Made redundant with Emacs-21's standard comment-dwim binding on M-; + (define-key ada-mode-map "\C-c;" 'comment-region) + (define-key ada-mode-map "\C-c:" 'ada-uncomment-region) + + ;; The following keys are bound to functions defined in ada-xref.el or + ;; ada-prj,el., However, RMS rightly thinks that the code should be shared, + ;; and activated only if the right compiler is used + + (define-key ada-mode-map (if (featurep 'xemacs) '(shift button3) [S-mouse-3]) + 'ada-point-and-xref) + (define-key ada-mode-map [(control tab)] 'ada-complete-identifier) + + (define-key ada-mode-extra-map "o" 'ff-find-other-file) + (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame) + (define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration) + (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference) + (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application) + (define-key ada-mode-extra-map "c" 'ada-change-prj) + (define-key ada-mode-extra-map "d" 'ada-set-default-project-file) + (define-key ada-mode-extra-map "g" 'ada-gdb-application) + (define-key ada-mode-map "\C-c\C-m" 'ada-set-main-compile-application) + (define-key ada-mode-extra-map "r" 'ada-run-application) + (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent) + (define-key ada-mode-map "\C-c\C-r" 'ada-find-references) + (define-key ada-mode-extra-map "l" 'ada-find-local-references) + (define-key ada-mode-map "\C-c\C-v" 'ada-check-current) + (define-key ada-mode-extra-map "f" 'ada-find-file) + + (define-key ada-mode-extra-map "u" 'ada-prj-edit) + + (define-key ada-mode-map "\C-xnd" 'ada-narrow-to-defun); override narrow-to-defun + + ;; The templates, defined in ada-stmt.el + + (let ((map (make-sparse-keymap))) + (define-key map "h" 'ada-header) + (define-key map "\C-a" 'ada-array) + (define-key map "b" 'ada-exception-block) + (define-key map "d" 'ada-declare-block) + (define-key map "c" 'ada-case) + (define-key map "\C-e" 'ada-elsif) + (define-key map "e" 'ada-else) + (define-key map "\C-k" 'ada-package-spec) + (define-key map "k" 'ada-package-body) + (define-key map "\C-p" 'ada-procedure-spec) + (define-key map "p" 'ada-subprogram-body) + (define-key map "\C-f" 'ada-function-spec) + (define-key map "f" 'ada-for-loop) + (define-key map "i" 'ada-if) + (define-key map "l" 'ada-loop) + (define-key map "\C-r" 'ada-record) + (define-key map "\C-s" 'ada-subtype) + (define-key map "S" 'ada-tabsize) + (define-key map "\C-t" 'ada-task-spec) + (define-key map "t" 'ada-task-body) + (define-key map "\C-y" 'ada-type) + (define-key map "\C-v" 'ada-private) + (define-key map "u" 'ada-use) + (define-key map "\C-u" 'ada-with) + (define-key map "\C-w" 'ada-when) + (define-key map "w" 'ada-while-loop) + (define-key map "\C-x" 'ada-exception) + (define-key map "x" 'ada-exit) + (define-key ada-mode-extra-map "t" map)) + ) + + +(defun ada-create-menu () + "Create the Ada menu as shown in the menu bar." + (let ((m '("Ada" + ("Help" + ["Ada Mode" (info "ada-mode") t] + ["GNAT User's Guide" (info "gnat_ugn") + (eq ada-which-compiler 'gnat)] + ["GNAT Reference Manual" (info "gnat_rm") + (eq ada-which-compiler 'gnat)] + ["Gcc Documentation" (info "gcc") + (eq ada-which-compiler 'gnat)] + ["Gdb Documentation" (info "gdb") + (eq ada-which-compiler 'gnat)] + ["Ada95 Reference Manual" (info "arm95") t]) + ("Options" :included (derived-mode-p 'ada-mode) + ["Auto Casing" (setq ada-auto-case (not ada-auto-case)) + :style toggle :selected ada-auto-case] + ["Auto Indent After Return" + (setq ada-indent-after-return (not ada-indent-after-return)) + :style toggle :selected ada-indent-after-return] + ["Automatically Recompile For Cross-references" + (setq ada-xref-create-ali (not ada-xref-create-ali)) + :style toggle :selected ada-xref-create-ali + :included (eq ada-which-compiler 'gnat)] + ["Confirm Commands" + (setq ada-xref-confirm-compile (not ada-xref-confirm-compile)) + :style toggle :selected ada-xref-confirm-compile + :included (eq ada-which-compiler 'gnat)] + ["Show Cross-references In Other Buffer" + (setq ada-xref-other-buffer (not ada-xref-other-buffer)) + :style toggle :selected ada-xref-other-buffer + :included (eq ada-which-compiler 'gnat)] + ["Tight Integration With GNU Visual Debugger" + (setq ada-tight-gvd-integration (not ada-tight-gvd-integration)) + :style toggle :selected ada-tight-gvd-integration + :included (string-match "gvd" ada-prj-default-debugger)]) + ["Customize" (customize-group 'ada) + :included (fboundp 'customize-group)] + ["Check file" ada-check-current t] + ["Compile file" ada-compile-current t] + ["Set main and Build" ada-set-main-compile-application t] + ["Show main" ada-show-current-main t] + ["Build" ada-compile-application t] + ["Run" ada-run-application t] + ["Debug" ada-gdb-application (eq ada-which-compiler 'gnat)] + ["------" nil nil] + ("Project" + ["Show project" ada-show-current-project t] + ["Load..." ada-set-default-project-file t] + ["New..." ada-prj-new t] + ["Edit..." ada-prj-edit t]) + ("Goto" :included (derived-mode-p 'ada-mode) + ["Goto Declaration/Body" ada-goto-declaration + (eq ada-which-compiler 'gnat)] + ["Goto Body" ada-goto-body + (eq ada-which-compiler 'gnat)] + ["Goto Declaration Other Frame" + ada-goto-declaration-other-frame + (eq ada-which-compiler 'gnat)] + ["Goto Previous Reference" ada-xref-goto-previous-reference + (eq ada-which-compiler 'gnat)] + ["List Local References" ada-find-local-references + (eq ada-which-compiler 'gnat)] + ["List References" ada-find-references + (eq ada-which-compiler 'gnat)] + ["Goto Reference To Any Entity" ada-find-any-references + (eq ada-which-compiler 'gnat)] + ["Goto Parent Unit" ada-goto-parent + (eq ada-which-compiler 'gnat)] + ["--" nil nil] + ["Next compilation error" next-error t] + ["Previous Package" ada-previous-package t] + ["Next Package" ada-next-package t] + ["Previous Procedure" ada-previous-procedure t] + ["Next Procedure" ada-next-procedure t] + ["Goto Start Of Statement" ada-move-to-start t] + ["Goto End Of Statement" ada-move-to-end t] + ["-" nil nil] + ["Other File" ff-find-other-file t] + ["Other File Other Window" ada-ff-other-window t]) + ("Edit" :included (derived-mode-p 'ada-mode) + ["Search File On Source Path" ada-find-file t] + ["------" nil nil] + ["Complete Identifier" ada-complete-identifier t] + ["-----" nil nil] + ["Indent Line" ada-indent-current-function t] + ["Justify Current Indentation" ada-justified-indent-current t] + ["Indent Lines in Selection" ada-indent-region t] + ["Indent Lines in File" + (ada-indent-region (point-min) (point-max)) t] + ["Format Parameter List" ada-format-paramlist t] + ["-" nil nil] + ["Comment Selection" comment-region t] + ["Uncomment Selection" ada-uncomment-region t] + ["--" nil nil] + ["Fill Comment Paragraph" fill-paragraph t] + ["Fill Comment Paragraph Justify" + ada-fill-comment-paragraph-justify t] + ["Fill Comment Paragraph Postfix" + ada-fill-comment-paragraph-postfix t] + ["---" nil nil] + ["Adjust Case Selection" ada-adjust-case-region t] + ["Adjust Case in File" ada-adjust-case-buffer t] + ["Create Case Exception" ada-create-case-exception t] + ["Create Case Exception Substring" + ada-create-case-exception-substring t] + ["Reload Case Exceptions" ada-case-read-exceptions t] + ["----" nil nil] + ["Make body for subprogram" ada-make-subprogram-body t] + ["-----" nil nil] + ["Narrow to subprogram" ada-narrow-to-defun t]) + ("Templates" + :included (derived-mode-p 'ada-mode) + ["Header" ada-header t] + ["-" nil nil] + ["Package Body" ada-package-body t] + ["Package Spec" ada-package-spec t] + ["Function Spec" ada-function-spec t] + ["Procedure Spec" ada-procedure-spec t] + ["Proc/func Body" ada-subprogram-body t] + ["Task Body" ada-task-body t] + ["Task Spec" ada-task-spec t] + ["Declare Block" ada-declare-block t] + ["Exception Block" ada-exception-block t] + ["--" nil nil] + ["Entry" ada-entry t] + ["Entry family" ada-entry-family t] + ["Select" ada-select t] + ["Accept" ada-accept t] + ["Or accept" ada-or-accept t] + ["Or delay" ada-or-delay t] + ["Or terminate" ada-or-terminate t] + ["---" nil nil] + ["Type" ada-type t] + ["Private" ada-private t] + ["Subtype" ada-subtype t] + ["Record" ada-record t] + ["Array" ada-array t] + ["----" nil nil] + ["If" ada-if t] + ["Else" ada-else t] + ["Elsif" ada-elsif t] + ["Case" ada-case t] + ["-----" nil nil] + ["While Loop" ada-while-loop t] + ["For Loop" ada-for-loop t] + ["Loop" ada-loop t] + ["------" nil nil] + ["Exception" ada-exception t] + ["Exit" ada-exit t] + ["When" ada-when t]) + ))) + + (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode" m) + (if (featurep 'xemacs) + (progn + (define-key ada-mode-map [menu-bar] ada-mode-menu) + (setq mode-popup-menu (cons "Ada mode" ada-mode-menu)))))) + + +;; ------------------------------------------------------- +;; Commenting/Uncommenting code +;; The following two calls are provided to enhance the standard +;; comment-region function, which only allows uncommenting if the +;; comment is at the beginning of a line. If the line have been re-indented, +;; we are unable to use comment-region, which makes no sense. +;; +;; In addition, we provide an interface to the standard comment handling +;; function for justifying the comments. +;; ------------------------------------------------------- + +(when (or (<= emacs-major-version 20) (featurep 'xemacs)) + (defadvice comment-region (before ada-uncomment-anywhere disable) + (if (and (consp arg) ;; a prefix with \C-u is of the form '(4), whereas + ;; \C-u 2 sets arg to '2' (fixed by S.Leake) + (derived-mode-p 'ada-mode)) + (save-excursion + (let ((cs (concat "^[ \t]*" (regexp-quote comment-start)))) + (goto-char beg) + (while (re-search-forward cs end t) + (replace-match comment-start)) + ))))) + +(defun ada-uncomment-region (beg end &optional arg) + "Uncomment region BEG .. END. +ARG gives number of comment characters." + (interactive "r\nP") + + ;; This advice is not needed anymore with Emacs21. However, for older + ;; versions, as well as for XEmacs, we still need to enable it. + (if (or (<= emacs-major-version 20) (featurep 'xemacs)) + (progn + (ad-activate 'comment-region) + (comment-region beg end (- (or arg 2))) + (ad-deactivate 'comment-region)) + (comment-region beg end (list (- (or arg 2)))) + (ada-indent-region beg end))) + +(defun ada-fill-comment-paragraph-justify () + "Fill current comment paragraph and justify each line as well." + (interactive) + (ada-fill-comment-paragraph 'full)) + +(defun ada-fill-comment-paragraph-postfix () + "Fill current comment paragraph and justify each line as well. +Adds `ada-fill-comment-postfix' at the end of each line." + (interactive) + (ada-fill-comment-paragraph 'full t)) + +(defun ada-fill-comment-paragraph (&optional justify postfix) + "Fill the current comment paragraph. +If JUSTIFY is non-nil, each line is justified as well. +If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended +to each line filled and justified. +The paragraph is indented on the first line." + (interactive "P") + + ;; check if inside comment or just in front a comment + (if (and (not (ada-in-comment-p)) + (not (looking-at "[ \t]*--"))) + (error "Not inside comment")) + + (let* (indent from to + (opos (point-marker)) + + ;; Sets this variable to nil, otherwise it prevents + ;; fill-region-as-paragraph to work on Emacs <= 20.2 + (parse-sexp-lookup-properties nil) + + fill-prefix + (fill-column (current-fill-column))) + + ;; Find end of paragraph + (back-to-indentation) + (while (and (not (eobp)) (looking-at ".*--[ \t]*[^ \t\n]")) + (forward-line 1) + + ;; If we were at the last line in the buffer, create a dummy empty + ;; line at the end of the buffer. + (if (eobp) + (insert "\n") + (back-to-indentation))) + (beginning-of-line) + (setq to (point-marker)) + (goto-char opos) + + ;; Find beginning of paragraph + (back-to-indentation) + (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]")) + (forward-line -1) + (back-to-indentation)) + + ;; We want one line above the first one, unless we are at the beginning + ;; of the buffer + (unless (bobp) + (forward-line 1)) + (beginning-of-line) + (setq from (point-marker)) + + ;; Calculate the indentation we will need for the paragraph + (back-to-indentation) + (setq indent (current-column)) + ;; unindent the first line of the paragraph + (delete-region from (point)) + + ;; Remove the old postfixes + (goto-char from) + (while (re-search-forward "--\n" to t) + (replace-match "\n")) + + (goto-char (1- to)) + (setq to (point-marker)) + + ;; Indent and justify the paragraph + (setq fill-prefix ada-fill-comment-prefix) + (set-left-margin from to indent) + (if postfix + (setq fill-column (- fill-column (length ada-fill-comment-postfix)))) + + (fill-region-as-paragraph from to justify) + + ;; Add the postfixes if required + (if postfix + (save-restriction + (goto-char from) + (narrow-to-region from to) + (while (not (eobp)) + (end-of-line) + (insert-char ? (- fill-column (current-column))) + (insert ada-fill-comment-postfix) + (forward-line)) + )) + + ;; In Emacs <= 20.2 and XEmacs <=20.4, there is a bug, and a newline is + ;; inserted at the end. Delete it + (if (or (featurep 'xemacs) + (<= emacs-major-version 19) + (and (= emacs-major-version 20) + (<= emacs-minor-version 2))) + (progn + (goto-char to) + (end-of-line) + (delete-char 1))) + + (goto-char opos))) + + +;; --------------------------------------------------- +;; support for find-file.el +;; These functions are used by find-file to guess the file names from +;; unit names, and to find the other file (spec or body) from the current +;; file (body or spec). +;; It is also used to find in which function we are, so as to put the +;; cursor at the correct position. +;; Standard Ada does not force any relation between unit names and file names, +;; so some of these functions can only be a good approximation. However, they +;; are also overridden in `ada-xref'.el when we know that the user is using +;; GNAT. +;; --------------------------------------------------- + +;; Overridden when we work with GNAT, to use gnatkrunch +(defun ada-make-filename-from-adaname (adaname) + "Determine the filename in which ADANAME is found. +This matches the GNAT default naming convention, except for +pre-defined units." + (while (string-match "\\." adaname) + (setq adaname (replace-match "-" t t adaname))) + (downcase adaname) + ) + +(defun ada-other-file-name () + "Return the name of the other file. +The name returned is the body if `current-buffer' is the spec, +or the spec otherwise." + + (let ((is-spec nil) + (is-body nil) + (suffixes ada-spec-suffixes) + (name (buffer-file-name))) + + ;; Guess whether we have a spec or a body, and get the basename of the + ;; file. Since the extension may not start with '.', we can not use + ;; file-name-extension + (while (and (not is-spec) + suffixes) + (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name) + (setq is-spec t + name (match-string 1 name))) + (setq suffixes (cdr suffixes))) + + (if (not is-spec) + (progn + (setq suffixes ada-body-suffixes) + (while (and (not is-body) + suffixes) + (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name) + (setq is-body t + name (match-string 1 name))) + (setq suffixes (cdr suffixes))))) + + ;; If this wasn't in either list, return name itself + (if (not (or is-spec is-body)) + name + + ;; Else find the other possible names + (if is-spec + (setq suffixes ada-body-suffixes) + (setq suffixes ada-spec-suffixes)) + (setq is-spec name) + + (while suffixes + + ;; If we are using project file, search for the other file in all + ;; the possible src directories. + + (if (fboundp 'ada-find-src-file-in-dir) + (let ((other + (ada-find-src-file-in-dir + (file-name-nondirectory (concat name (car suffixes)))))) + (if other + (setq is-spec other))) + + ;; Else search in the current directory + (if (file-exists-p (concat name (car suffixes))) + (setq is-spec (concat name (car suffixes))))) + (setq suffixes (cdr suffixes))) + + is-spec))) + +(defun ada-which-function-are-we-in () + "Return the name of the function whose definition/declaration point is in. +Used in `ff-pre-load-hook'." + (setq ff-function-name nil) + (save-excursion + (end-of-line);; make sure we get the complete name + (or (if (re-search-backward ada-procedure-start-regexp nil t) + (setq ff-function-name (match-string 5))) + (if (re-search-backward ada-package-start-regexp nil t) + (setq ff-function-name (match-string 4)))) + )) + + +(defvar ada-last-which-function-line -1 + "Last line on which `ada-which-function' was called.") +(defvar ada-last-which-function-subprog 0 + "Last subprogram name returned by `ada-which-function'.") +(make-variable-buffer-local 'ada-last-which-function-subprog) +(make-variable-buffer-local 'ada-last-which-function-line) + + +(defun ada-which-function () + "Return the name of the function whose body the point is in. +This function works even in the case of nested subprograms, whereas the +standard Emacs function `which-function' does not. +Since the search can be long, the results are cached." + + (let ((line (count-lines 1 (point))) + (pos (point)) + end-pos + func-name indent + found) + + ;; If this is the same line as before, simply return the same result + (if (= line ada-last-which-function-line) + ada-last-which-function-subprog + + (save-excursion + ;; In case the current line is also the beginning of the body + (end-of-line) + + ;; Are we looking at "function Foo\n (paramlist)" + (skip-chars-forward " \t\n(") + + (condition-case nil + (up-list 1) + (error nil)) + + (skip-chars-forward " \t\n") + (if (looking-at "return") + (progn + (forward-word-strictly 1) + (skip-chars-forward " \t\n") + (skip-chars-forward "a-zA-Z0-9_'"))) + + ;; Can't simply do forward-word, in case the "is" is not on the + ;; same line as the closing parenthesis + (skip-chars-forward "is \t\n") + + ;; No look for the closest subprogram body that has not ended yet. + ;; Not that we expect all the bodies to be finished by "end ", + ;; or a simple "end;" indented in the same column as the start of + ;; the subprogram. The goal is to be as efficient as possible. + + (while (and (not found) + (re-search-backward ada-imenu-subprogram-menu-re nil t)) + + ;; Get the function name, but not the properties, or this changes + ;; the face in the mode line on Emacs 21 + (setq func-name (match-string-no-properties 3)) + (if (and (not (ada-in-comment-p)) + (not (save-excursion + (goto-char (match-end 0)) + (looking-at "[ \t\n]*new")))) + (save-excursion + (back-to-indentation) + (setq indent (current-column)) + (if (ada-search-ignore-string-comment + (concat "end[ \t]+" func-name "[ \t]*;\\|^" + (make-string indent ? ) "end;")) + (setq end-pos (point)) + (setq end-pos (point-max))) + (if (>= end-pos pos) + (setq found func-name)))) + ) + (setq ada-last-which-function-line line + ada-last-which-function-subprog found) + found)))) + +(defun ada-ff-other-window () + "Find other file in other window using `ff-find-other-file'." + (interactive) + (and (fboundp 'ff-find-other-file) + (ff-find-other-file t))) + +(defun ada-set-point-accordingly () + "Move to the function declaration that was set by `ff-which-function-are-we-in'." + (if ff-function-name + (progn + (goto-char (point-min)) + (unless (ada-search-ignore-string-comment + (concat ff-function-name "\\b") nil) + (goto-char (point-min)))))) + +(defun ada-get-body-name (&optional spec-name) + "Return the file name for the body of SPEC-NAME. +If SPEC-NAME is nil, return the body for the current package. +Return nil if no body was found." + (interactive) + + (unless spec-name (setq spec-name (buffer-file-name))) + + ;; Remove the spec extension. We can not simply remove the file extension, + ;; but we need to take into account the specific non-GNAT extensions that the + ;; user might have specified. + + (let ((suffixes ada-spec-suffixes) + end) + (while suffixes + (setq end (- (length spec-name) (length (car suffixes)))) + (if (string-equal (car suffixes) (substring spec-name end)) + (setq spec-name (substring spec-name 0 end))) + (setq suffixes (cdr suffixes)))) + + ;; If find-file.el was available, use its functions + (if (fboundp 'ff-get-file-name) + (ff-get-file-name ada-search-directories-internal + (ada-make-filename-from-adaname + (file-name-nondirectory + (file-name-sans-extension spec-name))) + ada-body-suffixes) + ;; Else emulate it very simply + (concat (ada-make-filename-from-adaname + (file-name-nondirectory + (file-name-sans-extension spec-name))) + ".adb"))) + + +;; --------------------------------------------------- +;; support for font-lock.el +;; Strings are a real pain in Ada because a single quote character is +;; overloaded as a string quote and type/instance delimiter. By default, a +;; single quote is given punctuation syntax in `ada-mode-syntax-table'. +;; So, for Font Lock mode purposes, we mark single quotes as having string +;; syntax when the gods that created Ada determine them to be. +;; +;; This only works in Emacs. See the comments before the grammar functions +;; at the beginning of this file for how this is done with XEmacs. +;; ---------------------------------------------------- + +(defconst ada-font-lock-syntactic-keywords + ;; Mark single quotes as having string quote syntax in 'c' instances. + ;; We used to explicitly avoid ''' as a special case for fear the buffer + ;; be highlighted as a string, but it seems this fear is unfounded. + ;; + ;; This sets the properties of the characters, so that ada-in-string-p + ;; correctly handles '"' too... + '(("[^a-zA-Z0-9)]\\('\\)[^\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?'))) + ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n))))) + +(defvar ada-font-lock-keywords + (eval-when-compile + (list + ;; + ;; handle "type T is access function return S;" + (list "\\<\\(function[ \t]+return\\)\\>" '(1 font-lock-keyword-face) ) + + ;; preprocessor line + (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-type-face t)) + + ;; + ;; accept, entry, function, package (body), protected (body|type), + ;; pragma, procedure, task (body) plus name. + (list (concat + "\\<\\(" + "accept\\|" + "entry\\|" + "function\\|" + "package[ \t]+body\\|" + "package\\|" + "pragma\\|" + "procedure\\|" + "protected[ \t]+body\\|" + "protected[ \t]+type\\|" + "protected\\|" + "task[ \t]+body\\|" + "task[ \t]+type\\|" + "task" + "\\)\\>[ \t]*" + "\\(\\sw+\\(\\.\\sw*\\)*\\)?") + '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t)) + ;; + ;; Optional keywords followed by a type name. + (list (concat ; ":[ \t]*" + "\\<\\(access[ \t]+all\\|access[ \t]+constant\\|access\\|constant\\|in[ \t]+reverse\\|\\|in[ \t]+out\\|in\\|out\\)\\>" + "[ \t]*" + "\\(\\sw+\\(\\.\\sw*\\)*\\)?") + '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t)) + + ;; + ;; Main keywords, except those treated specially below. + (concat "\\<" + (regexp-opt + '("abort" "abs" "abstract" "accept" "access" "aliased" "all" + "and" "array" "at" "begin" "case" "declare" "delay" "delta" + "digits" "do" "else" "elsif" "entry" "exception" "exit" "for" + "generic" "if" "in" "interface" "is" "limited" "loop" "mod" "not" + "null" "or" "others" "overriding" "private" "protected" "raise" + "range" "record" "rem" "renames" "requeue" "return" "reverse" + "select" "separate" "synchronized" "tagged" "task" "terminate" + "then" "until" "when" "while" "with" "xor") t) + "\\>") + ;; + ;; Anything following end and not already fontified is a body name. + '("\\<\\(end\\)\\>\\([ \t]+\\)?\\(\\(\\sw\\|[_.]\\)+\\)?" + (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) + ;; + ;; Keywords followed by a type or function name. + (list (concat "\\<\\(" + "new\\|of\\|subtype\\|type" + "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?") + '(1 font-lock-keyword-face) + '(2 (if (match-beginning 4) + font-lock-function-name-face + font-lock-type-face) nil t)) + ;; + ;; Keywords followed by a (comma separated list of) reference. + ;; Note that font-lock only works on single lines, thus we can not + ;; correctly highlight a with_clause that spans multiple lines. + (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)" + "[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W") + '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t)) + + ;; + ;; Goto tags. + '("<<\\(\\sw+\\)>>" 1 font-lock-constant-face) + + ;; Highlight based-numbers (R. Reagan ) + (list "\\([0-9]+#[[:xdigit:]_]+#\\)" '(1 font-lock-constant-face t)) + + ;; Ada unnamed numerical constants + (list "\\W\\([-+]?[0-9._]+\\)\\>" '(1 font-lock-constant-face)) + + )) + "Default expressions to highlight in Ada mode.") + + +;; --------------------------------------------------------- +;; Support for outline.el +;; --------------------------------------------------------- + +(defun ada-outline-level () + "This is so that `current-column' DTRT in otherwise-hidden text." + ;; patch from Dave Love + (let (buffer-invisibility-spec) + (save-excursion + (back-to-indentation) + (current-column)))) + +;; --------------------------------------------------------- +;; Support for narrow-to-region +;; --------------------------------------------------------- + +(defun ada-narrow-to-defun (&optional _arg) + "Make text outside current subprogram invisible. +The subprogram visible is the one that contains or follow point. +Optional ARG is ignored. +Use \\[widen] to go back to the full visibility for the buffer." + + (interactive) + (save-excursion + (let (end) + (widen) + (forward-line 1) + (ada-previous-procedure) + (setq end (point-at-bol)) + (ada-move-to-end) + (end-of-line) + (narrow-to-region end (point)) + (message + "Use M-x widen to get back to full visibility in the buffer")))) + +;; --------------------------------------------------------- +;; Automatic generation of code +;; The Ada mode has a set of function to automatically generate a subprogram +;; or package body from its spec. +;; These function only use a primary and basic algorithm, this could use a +;; lot of improvement. +;; When the user is using GNAT, we rather use gnatstub to generate an accurate +;; body. +;; ---------------------------------------------------------- + +(defun ada-gen-treat-proc (match) + "Make dummy body of a procedure/function specification. +MATCH is a cons cell containing the start and end locations of the last search +for `ada-procedure-start-regexp'." + (goto-char (car match)) + (let (func-found procname functype) + (cond + ((or (looking-at "^[ \t]*procedure") + (setq func-found (looking-at "^[ \t]*function"))) + ;; treat it as a proc/func + (forward-word-strictly 2) + (forward-word-strictly -1) + (setq procname (buffer-substring (point) (cdr match))) ; store proc name + + ;; goto end of procname + (goto-char (cdr match)) + + ;; skip over parameterlist + (unless (looking-at "[ \t\n]*\\(;\\|return\\)") + (forward-sexp)) + + ;; if function, skip over 'return' and result type. + (if func-found + (progn + (forward-word-strictly 1) + (skip-chars-forward " \t\n") + (setq functype (buffer-substring (point) + (progn + (skip-chars-forward + "a-zA-Z0-9_.") + (point)))))) + ;; look for next non WS + (cond + ((looking-at "[ \t]*;") + (delete-region (match-beginning 0) (match-end 0));; delete the ';' + (ada-indent-newline-indent) + (insert "is") + (ada-indent-newline-indent) + (if func-found + (progn + (insert "Result : " functype ";") + (ada-indent-newline-indent))) + (insert "begin") + (ada-indent-newline-indent) + (if func-found + (insert "return Result;") + (insert "null;")) + (ada-indent-newline-indent) + (insert "end " procname ";") + (ada-indent-newline-indent) + ) + + ((looking-at "[ \t\n]*is") + ;; do nothing + ) + + ((looking-at "[ \t\n]*rename") + ;; do nothing + ) + + (t + (message "unknown syntax")))) + (t + (if (looking-at "^[ \t]*task") + (progn + (message "Task conversion is not yet implemented") + (forward-word-strictly 2) + (if (looking-at "[ \t]*;") + (forward-line) + (ada-move-to-end)) + )))))) + +(defun ada-make-body () + "Create an Ada package body in the current buffer. +The spec must be the previously visited buffer. +This function typically is to be hooked into `ff-file-created-hook'." + (delete-region (point-min) (point-max)) + (insert-buffer-substring (car (cdr (buffer-list)))) + (goto-char (point-min)) + (ada-mode) + + (let (found ada-procedure-or-package-start-regexp) + (if (setq found + (ada-search-ignore-string-comment ada-package-start-regexp nil)) + (progn (goto-char (cdr found)) + (insert " body") + ) + (error "No package")) + + (setq ada-procedure-or-package-start-regexp + (concat ada-procedure-start-regexp + "\\|" + ada-package-start-regexp)) + + (while (setq found + (ada-search-ignore-string-comment + ada-procedure-or-package-start-regexp nil)) + (progn + (goto-char (car found)) + (if (looking-at ada-package-start-regexp) + (progn (goto-char (cdr found)) + (insert " body")) + (ada-gen-treat-proc found)))))) + + +(defun ada-make-subprogram-body () + "Create a dummy subprogram body in package body file from spec surrounding point." + (interactive) + (let* ((found (re-search-backward ada-procedure-start-regexp nil t)) + (spec (match-beginning 0)) + body-file) + (if found + (progn + (goto-char spec) + (if (and (re-search-forward "(\\|;" nil t) + (= (char-before) ?\()) + (progn + (ada-search-ignore-string-comment ")" nil) + (ada-search-ignore-string-comment ";" nil))) + (setq spec (buffer-substring spec (point))) + + ;; If find-file.el was available, use its functions + (setq body-file (ada-get-body-name)) + (if body-file + (find-file body-file) + (error "No body found for the package. Create it first")) + + (save-restriction + (widen) + (goto-char (point-max)) + (forward-comment -10000) + (re-search-backward "\\" nil t) + ;; Move to the beginning of the elaboration part, if any + (re-search-backward "^begin" nil t) + (newline) + (forward-char -1) + (insert spec) + (re-search-backward ada-procedure-start-regexp nil t) + (ada-gen-treat-proc (cons (match-beginning 0) (match-end 0))) + )) + (error "Not in subprogram spec")))) + +;; -------------------------------------------------------- +;; Global initializations +;; -------------------------------------------------------- + +;; Create the keymap once and for all. If we do that in ada-mode, +;; the keys changed in the user's .emacs have to be modified +;; every time +(ada-create-keymap) +(ada-create-menu) + +;; Add the default extensions (and set up speedbar) +(ada-add-extensions ".ads" ".adb") +;; This two files are generated by GNAT when running with -gnatD +(if (equal ada-which-compiler 'gnat) + (ada-add-extensions ".ads.dg" ".adb.dg")) + +;; Read the special cases for exceptions +(ada-case-read-exceptions) + +;; Setup auto-loading of the other Ada mode files. +(autoload 'ada-change-prj "ada-xref" nil t) +(autoload 'ada-check-current "ada-xref" nil t) +(autoload 'ada-compile-application "ada-xref" nil t) +(autoload 'ada-compile-current "ada-xref" nil t) +(autoload 'ada-complete-identifier "ada-xref" nil t) +(autoload 'ada-find-file "ada-xref" nil t) +(autoload 'ada-find-any-references "ada-xref" nil t) +(autoload 'ada-find-src-file-in-dir "ada-xref" nil t) +(autoload 'ada-find-local-references "ada-xref" nil t) +(autoload 'ada-find-references "ada-xref" nil t) +(autoload 'ada-gdb-application "ada-xref" nil t) +(autoload 'ada-goto-declaration "ada-xref" nil t) +(autoload 'ada-goto-declaration-other-frame "ada-xref" nil t) +(autoload 'ada-goto-parent "ada-xref" nil t) +(autoload 'ada-make-body-gnatstub "ada-xref" nil t) +(autoload 'ada-point-and-xref "ada-xref" nil t) +(autoload 'ada-reread-prj-file "ada-xref" nil t) +(autoload 'ada-run-application "ada-xref" nil t) +(autoload 'ada-set-default-project-file "ada-xref" nil t) +(autoload 'ada-xref-goto-previous-reference "ada-xref" nil t) +(autoload 'ada-set-main-compile-application "ada-xref" nil t) +(autoload 'ada-show-current-main "ada-xref" nil t) + +(autoload 'ada-customize "ada-prj" nil t) +(autoload 'ada-prj-edit "ada-prj" nil t) +(autoload 'ada-prj-new "ada-prj" nil t) +(autoload 'ada-prj-save "ada-prj" nil t) + +(autoload 'ada-array "ada-stmt" nil t) +(autoload 'ada-case "ada-stmt" nil t) +(autoload 'ada-declare-block "ada-stmt" nil t) +(autoload 'ada-else "ada-stmt" nil t) +(autoload 'ada-elsif "ada-stmt" nil t) +(autoload 'ada-exception "ada-stmt" nil t) +(autoload 'ada-exception-block "ada-stmt" nil t) +(autoload 'ada-exit "ada-stmt" nil t) +(autoload 'ada-for-loop "ada-stmt" nil t) +(autoload 'ada-function-spec "ada-stmt" nil t) +(autoload 'ada-header "ada-stmt" nil t) +(autoload 'ada-if "ada-stmt" nil t) +(autoload 'ada-loop "ada-stmt" nil t) +(autoload 'ada-package-body "ada-stmt" nil t) +(autoload 'ada-package-spec "ada-stmt" nil t) +(autoload 'ada-private "ada-stmt" nil t) +(autoload 'ada-procedure-spec "ada-stmt" nil t) +(autoload 'ada-record "ada-stmt" nil t) +(autoload 'ada-subprogram-body "ada-stmt" nil t) +(autoload 'ada-subtype "ada-stmt" nil t) +(autoload 'ada-tabsize "ada-stmt" nil t) +(autoload 'ada-task-body "ada-stmt" nil t) +(autoload 'ada-task-spec "ada-stmt" nil t) +(autoload 'ada-type "ada-stmt" nil t) +(autoload 'ada-use "ada-stmt" nil t) +(autoload 'ada-when "ada-stmt" nil t) +(autoload 'ada-while-loop "ada-stmt" nil t) +(autoload 'ada-with "ada-stmt" nil t) + +;;; provide ourselves +(provide 'ada-mode) + +;;; ada-mode.el ends here diff --git a/old-ada/ada-prj.el b/old-ada/ada-prj.el new file mode 100644 index 0000000..d9fa77c --- /dev/null +++ b/old-ada/ada-prj.el @@ -0,0 +1,682 @@ +;;; ada-prj.el --- GUI editing of project files for the ada-mode + +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. + +;; Author: Emmanuel Briot +;; Maintainer: Stephen Leake +;; Keywords: languages, ada, project file +;; Package: ada-mode + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This package provides a set of functions to easily edit the project +;; files used by the ada-mode. +;; The only function publicly available here is `ada-customize'. +;; See the documentation of the Ada mode for more information on the project +;; files. +;; Internally, a project file is represented as a property list, with each +;; field of the project file matching one property of the list. + +;;; Code: + + +;; ----- Requirements ----------------------------------------------------- + +(require 'cus-edit) +(require 'ada-xref) + +(eval-when-compile + (require 'ada-mode)) +(eval-when-compile (require 'cl-lib)) + +;; ----- Buffer local variables ------------------------------------------- + +(defvar ada-prj-current-values nil + "Hold the current value of the fields, This is a property list.") +(make-variable-buffer-local 'ada-prj-current-values) + +(defvar ada-prj-default-values nil + "Hold the default value for the fields, This is a property list.") +(make-variable-buffer-local 'ada-prj-default-values) + +(defvar ada-prj-ada-buffer nil + "Indicates what Ada source file was being edited.") + +(defvar ada-old-cross-prefix nil + "The cross-prefix associated with the currently loaded runtime library.") + + +;; ----- Functions -------------------------------------------------------- + +(defun ada-prj-new () + "Open a new project file." + (interactive) + (let* ((prj + (if (and ada-prj-default-project-file + (not (string= ada-prj-default-project-file ""))) + ada-prj-default-project-file + "default.adp")) + (filename (read-file-name "Project file: " + (if prj "" nil) + nil + nil + prj))) + (if (not (string= (file-name-extension filename t) ".adp")) + (error "File name extension for project files must be .adp")) + + (ada-customize nil filename))) + +(defun ada-prj-edit () + "Editing the project file associated with the current Ada buffer. +If there is none, opens a new project file." + (interactive) + (if ada-prj-default-project-file + (ada-customize) + (ada-prj-new))) + +(defun ada-prj-initialize-values (symbol _ada-buffer filename) + "Set SYMBOL to the property list of the project file FILENAME. +If FILENAME is null, read the file associated with ADA-BUFFER. +If no project file is found, return the default values." +;; FIXME: rationalize arguments; make ada-buffer optional? + (if (and filename + (not (string= filename "")) + (assoc filename ada-xref-project-files)) + (set symbol (copy-sequence (cdr (assoc filename ada-xref-project-files)))) + + ;; Set default values (except for the file name if this was given + ;; in the buffer + (set symbol (ada-default-prj-properties)) + (if (and filename (not (string= filename ""))) + (set symbol (plist-put (eval symbol) 'filename filename))) + )) + + +(defun ada-prj-save-specific-option (field) + "Return the string to print in the project file to save FIELD. +If the current value of FIELD is the default value, return an empty string." + (if (string= (plist-get ada-prj-current-values field) + (plist-get ada-prj-default-values field)) + "" + (concat (symbol-name field) + "=" (plist-get ada-prj-current-values field) "\n"))) + +(defun ada-prj-save () + "Save the edited project file." + (interactive) + (let ((file-name (or (plist-get ada-prj-current-values 'filename) + (read-file-name "Save project as: "))) + output) + (setq output + (concat + + ;; Save the fields that do not depend on the current buffer + ;; only if they are different from the default value + + (ada-prj-save-specific-option 'comp_opt) + (ada-prj-save-specific-option 'bind_opt) + (ada-prj-save-specific-option 'link_opt) + (ada-prj-save-specific-option 'gnatmake_opt) + (ada-prj-save-specific-option 'gnatfind_opt) + (ada-prj-save-specific-option 'cross_prefix) + (ada-prj-save-specific-option 'remote_machine) + (ada-prj-save-specific-option 'debug_cmd) + + ;; Always save the fields that depend on the current buffer + "main=" (plist-get ada-prj-current-values 'main) "\n" + "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n" + (ada-prj-set-list "check_cmd" + (plist-get ada-prj-current-values 'check_cmd)) "\n" + (ada-prj-set-list "make_cmd" + (plist-get ada-prj-current-values 'make_cmd)) "\n" + (ada-prj-set-list "comp_cmd" + (plist-get ada-prj-current-values 'comp_cmd)) "\n" + (ada-prj-set-list "run_cmd" + (plist-get ada-prj-current-values 'run_cmd)) "\n" + (ada-prj-set-list "src_dir" + (plist-get ada-prj-current-values 'src_dir) + t) "\n" + (ada-prj-set-list "obj_dir" + (plist-get ada-prj-current-values 'obj_dir) + t) "\n" + (ada-prj-set-list "debug_pre_cmd" + (plist-get ada-prj-current-values 'debug_pre_cmd)) + "\n" + (ada-prj-set-list "debug_post_cmd" + (plist-get ada-prj-current-values 'debug_post_cmd)) + "\n" + )) + + (find-file file-name) + (erase-buffer) + (insert output) + (save-buffer) + ;; kill the project buffer + (kill-buffer nil) + + ;; kill the editor buffer + (kill-buffer "*Edit Ada Mode Project*") + + ;; automatically set the new project file as the active one + (setq ada-prj-default-project-file file-name) + + ;; force Emacs to reread the project files + (ada-reread-prj-file file-name) + ) + ) + +(defun ada-prj-load-from-file (symbol) + "Load SYMBOL value from file. +One item per line should be found in the file." + (save-excursion + (let ((file (read-file-name "File name: " nil nil t)) + (buffer (current-buffer)) + line + list) + (find-file file) + (widen) + (goto-char (point-min)) + (while (not (eobp)) + (setq line (buffer-substring-no-properties (point) (point-at-eol))) + (cl-pushnew line list :test #'equal) + (forward-line 1)) + (kill-buffer nil) + (set-buffer buffer) + (setq ada-prj-current-values + (plist-put ada-prj-current-values + symbol + (append (plist-get ada-prj-current-values symbol) + (reverse list))))) + (ada-prj-display-page 2))) + +(defun ada-prj-subdirs-of (dir) + "Return a list of all the subdirectories of DIR, recursively." + (let ((subdirs (directory-files dir t "^[^.].*")) + (dirlist (list dir))) + (while subdirs + (if (file-directory-p (car subdirs)) + (let ((sub (ada-prj-subdirs-of (car subdirs)))) + (if sub + (setq dirlist (append sub dirlist))))) + (setq subdirs (cdr subdirs))) + dirlist)) + +(defun ada-prj-load-directory (field &optional file-name) + "Append to FIELD in the current project the subdirectories of FILE-NAME. +If FILE-NAME is nil, ask the user for the name." + + ;; Do not use an external dialog for this, since it wouldn't allow + ;; the user to select a directory + (let ((use-dialog-box nil)) + (unless file-name + (setq file-name (read-directory-name "Root directory: " nil nil t)))) + + (setq ada-prj-current-values + (plist-put ada-prj-current-values + field + (append (plist-get ada-prj-current-values field) + (reverse (ada-prj-subdirs-of + (expand-file-name file-name)))))) + (ada-prj-display-page 2)) + +(defun ada-prj-display-page (tab-num) + "Display page TAB-NUM in the notebook. +The current buffer must be the project editing buffer." + + (let ((inhibit-read-only t)) + (erase-buffer)) + + ;; Widget support in Emacs 21 requires that we clear the buffer first + (if (and (not (featurep 'xemacs)) (>= emacs-major-version 21)) + (progn + (setq widget-field-new nil + widget-field-list nil) + (mapc (lambda (x) (delete-overlay x)) (car (overlay-lists))) + (mapc (lambda (x) (delete-overlay x)) (cdr (overlay-lists))))) + + ;; Display the tabs + + (widget-insert "\n Project configuration.\n + ___________ ____________ ____________ ____________ ____________\n / ") + (widget-create 'push-button :notify + (lambda (&rest _dummy) (ada-prj-display-page 1)) "General") + (widget-insert " \\ / ") + (widget-create 'push-button :notify + (lambda (&rest _dummy) (ada-prj-display-page 2)) "Paths") + (widget-insert " \\ / ") + (widget-create 'push-button :notify + (lambda (&rest _dummy) (ada-prj-display-page 3)) "Switches") + (widget-insert " \\ / ") + (widget-create 'push-button :notify + (lambda (&rest _dummy) (ada-prj-display-page 4)) "Ada Menu") + (widget-insert " \\ / ") + (widget-create 'push-button :notify + (lambda (&rest _dummy) (ada-prj-display-page 5)) "Debugger") + (widget-insert " \\\n") + + ;; Display the currently selected page + + (cond + + ;; + ;; First page (General) + ;; + ((= tab-num 1) + (widget-insert "/ \\/______________\\/______________\\/______________\\/______________\\\n") + + (widget-insert "Project file name:\n") + (widget-insert (plist-get ada-prj-current-values 'filename)) + (widget-insert "\n\n") + (ada-prj-field 'casing "Casing Exceptions" +"List of files that contain casing exception +dictionaries. All these files contain one +identifier per line, with a special casing. +The first file has the highest priority." + t nil + (mapconcat (lambda(x) + (concat " " x)) + (ada-xref-get-project-field 'casing) + "\n") + ) + (ada-prj-field 'main "Executable file name" +"Name of the executable generated when you +compile your application. This should include +the full directory name, using ${build_dir} if +you wish.") + (ada-prj-field 'build_dir "Build directory" + "Reference directory for relative paths in +src_dir and obj_dir below. This is also the directory +where the compilation is done.") + (ada-prj-field 'remote_machine "Name of the remote machine (if any)" +"If you want to remotely compile, debug and +run your application, specify the name of a +remote machine here. This capability requires +the `rsh' protocol on the remote machine.") + (ada-prj-field 'cross_prefix "Prefix used in for the cross tool chain" +"When working on multiple cross targets, it is +most convenient to specify the prefix of the +tool chain here. For instance, on PowerPc +vxworks, you would enter `powerpc-wrs-vxworks-'. +To use JGNAT, enter `j'.") + ) + + + ;; + ;; Second page (Paths) + ;; + ((= tab-num 2) + (if (not (equal (plist-get ada-prj-current-values 'cross_prefix) + ada-old-cross-prefix)) + (progn + (setq ada-old-cross-prefix + (plist-get ada-prj-current-values 'cross_prefix)) + (ada-initialize-runtime-library ada-old-cross-prefix))) + + + (widget-insert "/_____________\\/ \\/______________\\/______________\\/______________\\\n") + (ada-prj-field 'src_dir "Source directories" +"Enter the list of directories where your Ada +sources can be found. These directories will be +used for the cross-references and for the default +compilation commands. +Note that src_dir includes both the build directory +and the standard runtime." + t t + (mapconcat (lambda(x) + (concat " " x)) + ada-xref-runtime-library-specs-path + "\n") + ) + (widget-insert "\n\n") + + (ada-prj-field 'obj_dir "Object directories" +"Enter the list of directories where the GNAT +library files (ALI files) can be found. These +files are used for cross-references and by the +gnatmake command. +Note that obj_dir includes both the build directory +and the standard runtime." + t t + (mapconcat (lambda(x) + (concat " " x)) + ada-xref-runtime-library-ali-path + "\n") + ) + (widget-insert "\n\n") + ) + + ;; + ;; Third page (Switches) + ;; + ((= tab-num 3) + (widget-insert "/_____________\\/______________\\/ \\/______________\\/______________\\\n") + (ada-prj-field 'comp_opt "Switches for the compiler" +"These switches are used in the default +compilation commands, both for compiling a +single file and rebuilding the whole project") + (ada-prj-field 'bind_opt "Switches for the binder" +"These switches are used in the default build +command and are passed to the binder") + (ada-prj-field 'link_opt "Switches for the linker" +"These switches are used in the default build +command and are passed to the linker") + (ada-prj-field 'gnatmake_opt "Switches for gnatmake" +"These switches are used in the default gnatmake +command.") + (ada-prj-field 'gnatfind_opt "Switches for gnatfind" +"The command gnatfind is run every time the Ada/Goto/List_References menu. +You should for instance add -a if you are working in an environment +where most ALI files are write-protected, since otherwise they get +ignored by gnatfind and you don't see the references within.") + ) + + ;; + ;; Fourth page + ;; + ((= tab-num 4) + (widget-insert "/_____________\\/______________\\/______________\\/ \\/______________\\\n") + (widget-insert +"All the fields below can use variable substitution. The syntax is ${name}, +where name is the name that appears after the Help buttons in this buffer. As +a special case, ${current} is replaced with the name of the file currently +edited, with directory name but no extension, whereas ${full_current} is +replaced with the name of the current file with directory name and +extension.\n") + (widget-insert +"The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are set to +${src_dir} and ${obj_dir} before running the compilation commands, so that you +don't need to specify the -aI and -aO switches on the command line\n") + (widget-insert +"You can reference any environment variable using the same ${...} syntax as +above, and put the name of the variable between the quotes.\n\n") + (ada-prj-field 'check_cmd + "Check syntax of a single file (menu Ada->Check File)" +"This command is run to check the syntax and semantics of a file. +The file name is added at the end of this command." t) + (ada-prj-field 'comp_cmd + "Compiling a single file (menu Ada->Compile File)" +"This command is run when the recompilation +of a single file is needed. The file name is +added at the end of this command." t) + (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)" +"This command is run when you want to rebuild +your whole application. It is never issues +automatically and you will need to ask for it. +If remote_machine has been set, this command +will be executed on the remote machine." t) + (ada-prj-field 'run_cmd "Running the application (menu Ada->Run)" +"This command specifies how to run the +application, including any switch you need to +specify. If remote_machine has been set, this +command will be executed on the remote host." t) + ) + + ;; + ;; Fifth page + ;; + ((= tab-num 5) + (widget-insert "/_____________\\/______________\\/______________\\/______________\\/ \\\n") + (ada-prj-field 'debug_pre_cmd "Commands to execute before launching the +debugger" +"The following commands are executed one after the other before starting +the debugger. These can be used to set up your environment." t) + + (ada-prj-field 'debug_cmd "Debugging the application" +"Specifies how to debug the application, possibly +remotely if remote_machine has been set. We +recommend the following debuggers: + > gdb + > gvd --tty + > ddd --tty -fullname -toolbar") + + (ada-prj-field 'debug_post_cmd "Commands to execute in the debugger" +"The following commands are executed one in the debugger once it has been +started. These can be used to initialize the debugger, for instance to +connect to the target when working with cross-environments" t) + ) + + ) + + + (widget-insert "______________________________________________________________________\n\n ") + (widget-create 'push-button + :notify (lambda (&rest _ignore) + (setq ada-prj-current-values (ada-default-prj-properties)) + (ada-prj-display-page 1)) + "Reset to Default Values") + (widget-insert " ") + (widget-create 'push-button :notify (lambda (&rest _ignore) (kill-buffer nil)) + "Cancel") + (widget-insert " ") + (widget-create 'push-button :notify (lambda (&rest _ignore) (ada-prj-save)) + "Save") + (widget-insert "\n\n") + + (widget-setup) + (with-no-warnings + (beginning-of-buffer)) + ) + + +(defun ada-customize (&optional new-file filename) + "Edit the project file associated with the current buffer. +If there is none or NEW-FILE is non-nil, make a new one. +If FILENAME is given, edit that file." + (interactive) + + (let ((ada-buffer (current-buffer)) + (inhibit-read-only t)) + + ;; We can only edit interactively the standard ada-mode project files. If + ;; the user is using other formats for the project file (through hooks in + ;; `ada-load-project-hook', we simply edit the file + + (if (and (not new-file) + (or ada-prj-default-project-file filename) + (string= (file-name-extension + (or filename ada-prj-default-project-file)) + "gpr")) + (progn + (find-file ada-prj-default-project-file) + (add-hook 'after-save-hook 'ada-reread-prj-file t t) + ) + + (if filename + (ada-reread-prj-file filename) + (if (not (string= ada-prj-default-project-file "")) + (ada-reread-prj-file ada-prj-default-project-file) + (ada-reread-prj-file))) + + (switch-to-buffer "*Edit Ada Mode Project*") + + (ada-prj-initialize-values 'ada-prj-current-values + ada-buffer + ada-prj-default-project-file) + + (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer) + + (use-local-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map custom-mode-map) + (define-key map "\C-x\C-s" 'ada-prj-save) + map)) + + ;; FIXME: Not sure if this works!! + (set (make-local-variable 'widget-keymap) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map widget-keymap) + (define-key map "\C-x\C-s" 'ada-prj-save) + map)) + + (set (make-local-variable 'ada-old-cross-prefix) + (ada-xref-get-project-field 'cross-prefix)) + + (ada-prj-display-page 1) + ))) + +;; ---------------- Utilities -------------------------------- + +(defun ada-prj-set-list (string ada-list &optional is-directory) + "Prepend STRING to strings in ADA-LIST, return new-line separated string. +If IS-DIRECTORY is non-nil, each element of ADA-LIST is explicitly +converted to a directory name." + + (mapconcat (lambda (x) (concat string "=" + (if is-directory + (file-name-as-directory x) + x))) + ada-list "\n")) + + +(defun ada-prj-field-modified (widget &rest _dummy) + "Callback for modification of WIDGET. +Remaining args DUMMY are ignored. +Save the change in `ada-prj-current-values' so that selecting +another page and coming back keeps the new value." + (setq ada-prj-current-values + (plist-put ada-prj-current-values + (widget-get widget ':prj-field) + (widget-value widget)))) + +(defun ada-prj-display-help (widget _widget-modified event) + "Callback for help button in WIDGET. +Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." + (let ((text (widget-get widget 'prj-help))) + (if event + ;; If we have a mouse-event, popup a menu + (widget-choose "Help" + (mapcar (lambda (a) (cons a t)) + (split-string text "\n")) + event) + ;; Else display the help string just before the next group of + ;; variables + (momentary-string-display + (concat "*****Help*****\n" text "\n**************\n") + (point-at-bol 2))))) + +(defun ada-prj-show-value (widget _widget-modified event) + "Show the current field value in WIDGET. +Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." + (let* ((field (widget-get widget ':prj-field)) + (value (plist-get ada-prj-current-values field)) + (inhibit-read-only t) + w) + + ;; If the other widget is already visible, delete it + (if (widget-get widget 'prj-other-widget) + (progn + (widget-delete (widget-get widget 'prj-other-widget)) + (widget-put widget 'prj-other-widget nil) + (widget-put widget ':prj-field field) + (widget-default-value-set widget "Show Value") + ) + + ;; Else create it + (save-excursion + (mouse-set-point event) + (forward-line 1) + (beginning-of-line) + (setq w (widget-create 'editable-list + :entry-format "%i%d %v" + :notify 'ada-prj-field-modified + :help-echo (widget-get widget 'prj-help) + :value value + (list 'editable-field :keymap widget-keymap))) + (widget-put widget 'prj-other-widget w) + (widget-put w ':prj-field field) + (widget-put widget ':prj-field field) + (widget-default-value-set widget "Hide Value") + ) + ) + (widget-setup) + )) + +(defun ada-prj-field (field text help-text &optional is-list is-paths after-text) + "Create a widget to edit FIELD in the current buffer. +TEXT is a short explanation of what the field means, whereas HELP-TEXT +is the text displayed when the user pressed the help button. +If IS-LIST is non-nil, the field contains a list. Otherwise, it contains +a single string. +If IS-PATHS is true, some special buttons are added to load paths,... +AFTER-TEXT is inserted just after the widget." + (let ((value (plist-get ada-prj-current-values field)) + (inhibit-read-only t) + widget) + (unless value + (setq value + (if is-list '() ""))) + (widget-insert text) + (widget-insert ":") + (move-to-column 54 t) + (widget-put (widget-create 'push-button + :notify 'ada-prj-display-help + "Help") + 'prj-help + help-text) + (widget-insert (concat " (" (symbol-name field) ")\n")) + (if is-paths + (progn + (widget-create 'push-button + :notify + (list 'lambda '(&rest dummy) '(interactive) + (list 'ada-prj-load-from-file + (list 'quote field))) + "Load From File") + (widget-insert " ") + (widget-create 'push-button + :notify + (list 'lambda '(&rest dummy) '(interactive) + (list 'ada-prj-load-directory + (list 'quote field))) + "Load Recursive Directory") + (widget-insert "\n ${build_dir}\n"))) + + (setq widget + (if is-list + (if (< (length value) 15) + (widget-create 'editable-list + :entry-format "%i%d %v" + :notify 'ada-prj-field-modified + :help-echo help-text + :value value + (list 'editable-field :keymap widget-keymap)) + + (let ((w (widget-create 'push-button + :notify 'ada-prj-show-value + "Show value"))) + (widget-insert "\n") + (widget-put w 'prj-help help-text) + (widget-put w 'prj-other-widget nil) + w) + ) + (widget-create 'editable-field + :format "%v" + :notify 'ada-prj-field-modified + :help-echo help-text + :keymap widget-keymap + value))) + (widget-put widget ':prj-field field) + (if after-text + (widget-insert after-text)) + (widget-insert "\n") + )) + + +(provide 'ada-prj) + +;;; ada-prj.el ends here diff --git a/old-ada/ada-stmt.el b/old-ada/ada-stmt.el new file mode 100644 index 0000000..ef42b0d --- /dev/null +++ b/old-ada/ada-stmt.el @@ -0,0 +1,486 @@ +;;; ada-stmt.el --- an extension to Ada mode for inserting statement templates + +;; Copyright (C) 1987, 1993-1994, 1996-2019 Free Software Foundation, +;; Inc. + +;; Authors: Daniel Pfeiffer +;; Markus Heritsch +;; Rolf Ebert +;; Maintainer: Stephen Leake +;; Keywords: languages, ada +;; Package: ada-mode + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; This file is now automatically loaded from ada-mode.el, and creates a submenu +;; in Ada/ on the menu bar. + +;;; History: + +;; Created May 1987. +;; Original version from V. Bowman as in ada.el of Emacs-18 +;; (borrowed heavily from Mick Jordan's Modula-2 package for GNU, +;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.) +;; +;; Sep 1993. Daniel Pfeiffer (DP) +;; Introduced statement.el for smaller code and user configurability. +;; +;; Nov 1993. Rolf Ebert (RE) Moved the +;; skeleton generation into this separate file. The code still is +;; essentially written by DP +;; +;; Adapted Jun 1994. Markus Heritsch +;; (MH) +;; added menu bar support for templates +;; +;; 1994/12/02 Christian Egli +;; General cleanup and bug fixes. +;; +;; 1995/12/20 John Hutchison +;; made it work with skeleton.el from Emacs-19.30. Several +;; enhancements and bug fixes. + +;; BUGS: +;;;> I have the following suggestions for the function template: 1) I +;;;> don't want it automatically assigning it a name for the return variable. I +;;;> never want it to be called "Result" because that is nondescript. If you +;;;> must define a variable, give me the ability to specify its name. +;;;> +;;;> 2) You do not provide a type for variable 'Result'. Its type is the same +;;;> as the function's return type, which the template knows, so why force me +;;;> to type it in? +;;;> + +;;;It would be nice if one could configure such layout details separately +;;;without patching the LISP code. Maybe the metalanguage used in ada-stmt.el +;;;could be taken even further, providing the user with some nice syntax +;;;for describing layout. Then my own hacks would survive the next +;;;update of the package :-) + + +;;; Code: + +(require 'skeleton nil t) +(require 'easymenu) +(require 'ada-mode) + +(defun ada-func-or-proc-name () + "Return the name of the current function or procedure." + (save-excursion + (let ((case-fold-search t)) + (if (re-search-backward ada-procedure-start-regexp nil t) + (match-string 5) + "NAME?")))) + +;;; ---- statement skeletons ------------------------------------------ + +(define-skeleton ada-array + "Insert array type definition. +Prompt for component type and index subtypes." + () + "array (" ("index definition: " str ", " ) -2 ") of " _ ?\;) + + +(define-skeleton ada-case + "Build skeleton case statement. +Prompt for the selector expression. Also builds the first when clause." + "[selector expression]: " + "case " str " is" \n + > "when " ("discrete choice: " str " | ") -3 " =>" \n + > _ \n + < < "end case;") + + +(define-skeleton ada-when + "Start a case statement alternative with a when clause." + () + < "when " ("discrete choice: " str " | ") -3 " =>" \n + >) + + +(define-skeleton ada-declare-block + "Insert a block with a declare part. +Indent for the first declaration." + "[block name]: " + < str & ?: & \n + > "declare" \n + > _ \n + < "begin" \n + > \n + < "end " str | -1 ?\;) + + +(define-skeleton ada-exception-block + "Insert a block with an exception part. +Indent for the first line of code." + "[block name]: " + < str & ?: & \n + > "begin" \n + > _ \n + < "exception" \n + > \n + < "end " str | -1 ?\;) + + +(define-skeleton ada-exception + "Insert an indented exception part into a block." + () + < "exception" \n + >) + + +(define-skeleton ada-exit-1 + "Insert then exit condition of the exit statement, prompting for condition." + "[exit condition]: " + "when " str | -5) + + +(define-skeleton ada-exit + "Insert an exit statement, prompting for loop name and condition." + "[name of loop to exit]: " + "exit " str & ?\ (ada-exit-1) | -1 ?\;) + +;;;###autoload +(defun ada-header () + "Insert a descriptive header at the top of the file." + (interactive "*") + (save-excursion + (goto-char (point-min)) + (if (fboundp 'make-header) + (funcall (symbol-function 'make-header)) + (ada-header-tmpl)))) + + +(define-skeleton ada-header-tmpl + "Insert a comment block containing the module title, author, etc." + "[Description]: " + "-- -*- Mode: Ada -*-" + "\n" ada-fill-comment-prefix "Filename : " (buffer-name) + "\n" ada-fill-comment-prefix "Description : " str + "\n" ada-fill-comment-prefix "Author : " (user-full-name) + "\n" ada-fill-comment-prefix "Created On : " (current-time-string) + "\n" ada-fill-comment-prefix "Last Modified By: ." + "\n" ada-fill-comment-prefix "Last Modified On: ." + "\n" ada-fill-comment-prefix "Update Count : 0" + "\n" ada-fill-comment-prefix "Status : Unknown, Use with caution!" + "\n") + + +(define-skeleton ada-display-comment + "Inserts three comment lines, making a display comment." + () + "--\n" ada-fill-comment-prefix _ "\n--") + + +(define-skeleton ada-if + "Insert skeleton if statement, prompting for a boolean-expression." + "[condition]: " + "if " str " then" \n + > _ \n + < "end if;") + + +(define-skeleton ada-elsif + "Add an elsif clause to an if statement, +prompting for the boolean-expression." + "[condition]: " + < "elsif " str " then" \n + >) + + +(define-skeleton ada-else + "Add an else clause inside an if-then-end-if clause." + () + < "else" \n + >) + + +(define-skeleton ada-loop + "Insert a skeleton loop statement. The exit statement is added by hand." + "[loop name]: " + < str & ?: & \n + > "loop" \n + > _ \n + < "end loop " str | -1 ?\;) + + +(define-skeleton ada-for-loop-prompt-variable + "Prompt for the loop variable." + "[loop variable]: " + str) + + +(define-skeleton ada-for-loop-prompt-range + "Prompt for the loop range." + "[loop range]: " + str) + + +(define-skeleton ada-for-loop + "Build a skeleton for-loop statement, prompting for the loop parameters." + "[loop name]: " + < str & ?: & \n + > "for " + (ada-for-loop-prompt-variable) + " in " + (ada-for-loop-prompt-range) + " loop" \n + > _ \n + < "end loop " str | -1 ?\;) + + +(define-skeleton ada-while-loop-prompt-entry-condition + "Prompt for the loop entry condition." + "[entry condition]: " + str) + + +(define-skeleton ada-while-loop + "Insert a skeleton while loop statement." + "[loop name]: " + < str & ?: & \n + > "while " + (ada-while-loop-prompt-entry-condition) + " loop" \n + > _ \n + < "end loop " str | -1 ?\;) + + +(define-skeleton ada-package-spec + "Insert a skeleton package specification." + "[package name]: " + "package " str " is" \n + > _ \n + < "end " str ?\;) + + +(define-skeleton ada-package-body + "Insert a skeleton package body -- includes a begin statement." + "[package name]: " + "package body " str " is" \n + > _ \n +; < "begin" \n + < "end " str ?\;) + + +(define-skeleton ada-private + "Undent and start a private section of a package spec. Reindent." + () + < "private" \n + >) + + +(define-skeleton ada-function-spec-prompt-return + "Prompts for function result type." + "[result type]: " + str) + + +(define-skeleton ada-function-spec + "Insert a function specification. Prompts for name and arguments." + "[function name]: " + "function " str + " (" ("[parameter_specification]: " str "; " ) -2 ")" + " return " + (ada-function-spec-prompt-return) + ";" \n ) + + +(define-skeleton ada-procedure-spec + "Insert a procedure specification, prompting for its name and arguments." + "[procedure name]: " + "procedure " str + " (" ("[parameter_specification]: " str "; " ) -2 ")" + ";" \n ) + + +(define-skeleton ada-subprogram-body + "Insert frame for subprogram body. +Invoke right after `ada-function-spec' or `ada-procedure-spec'." + () + ;; Remove `;' from subprogram decl + (save-excursion + (let ((pos (1+ (point)))) + (ada-search-ignore-string-comment ada-subprog-start-re t nil) + (when (ada-search-ignore-string-comment "(" nil pos t 'search-forward) + (backward-char 1) + (forward-sexp 1))) + (if (looking-at ";") + (delete-char 1))) + " is" \n + _ \n + < "begin" \n + \n + < "exception" \n + "when others => null;" \n + < < "end " + (ada-func-or-proc-name) + ";" \n) + + +(define-skeleton ada-separate + "Finish a body stub with `separate'." + () + > "separate;" \n + <) + + +;(define-skeleton ada-with +; "Inserts a with clause, prompting for the list of units depended upon." +; "[list of units depended upon]: " +; "with " str ?\;) + +;(define-skeleton ada-use +; "Inserts a use clause, prompting for the list of packages used." +; "[list of packages used]: " +; "use " str ?\;) + + +(define-skeleton ada-record + "Insert a skeleton record type declaration." + () + "record" \n + > _ \n + < "end record;") + + +(define-skeleton ada-subtype + "Start insertion of a subtype declaration, prompting for the subtype name." + "[subtype name]: " + "subtype " str " is " _ ?\; + (not (message "insert subtype indication."))) + + +(define-skeleton ada-type + "Start insertion of a type declaration, prompting for the type name." + "[type name]: " + "type " str ?\( + ("[discriminant specs]: " str " ") + | (backward-delete-char 1) | ?\) + " is " + (not (message "insert type definition."))) + + +(define-skeleton ada-task-body + "Insert a task body, prompting for the task name." + "[task name]: " + "task body " str " is\n" + "begin\n" + > _ \n + < "end " str ";" ) + + +(define-skeleton ada-task-spec + "Insert a task specification, prompting for the task name." + "[task name]: " + "task " str + " (" ("[discriminant]: " str "; ") ") is\n" + > "entry " _ \n + <"end " str ";" ) + + +(define-skeleton ada-get-param1 + "Prompt for arguments and if any enclose them in brackets." + () + ("[parameter_specification]: " str "; " ) & -2 & ")") + + +(define-skeleton ada-get-param + "Prompt for arguments and if any enclose them in brackets." + () + " (" + (ada-get-param1) | -2) + + +(define-skeleton ada-entry + "Insert a task entry, prompting for the entry name." + "[entry name]: " + "entry " str + (ada-get-param) + ";" \n) + + +(define-skeleton ada-entry-family-prompt-discriminant + "Insert an entry specification, prompting for the entry name." + "[discriminant name]: " + str) + + +(define-skeleton ada-entry-family + "Insert an entry specification, prompting for the entry name." + "[entry name]: " + "entry " str + " (" (ada-entry-family-prompt-discriminant) ")" + (ada-get-param) + ";" \n) + + +(define-skeleton ada-select + "Insert a select block." + () + "select\n" + > _ \n + < "end select;") + + +(define-skeleton ada-accept-1 + "Insert a condition statement, prompting for the condition name." + "[condition]: " + "when " str | -5 ) + + +(define-skeleton ada-accept-2 + "Insert an accept statement, prompting for the name and arguments." + "[accept name]: " + > "accept " str + (ada-get-param) + " do" \n + > _ \n + < "end " str ";" ) + + +(define-skeleton ada-accept + "Insert an accept statement (prompt for condition, name and arguments)." + () + > (ada-accept-1) & " =>\n" + (ada-accept-2)) + + +(define-skeleton ada-or-accept + "Insert an accept alternative, prompting for the condition name." + () + < "or\n" + (ada-accept)) + + +(define-skeleton ada-or-delay + "Insert a delay alternative, prompting for the delay value." + "[delay value]: " + < "or\n" + > "delay " str ";") + + +(define-skeleton ada-or-terminate + "Insert a terminate alternative." + () + < "or\n" + > "terminate;") + + +(provide 'ada-stmt) + +;;; ada-stmt.el ends here diff --git a/old-ada/ada-xref.el b/old-ada/ada-xref.el new file mode 100644 index 0000000..c9c923e --- /dev/null +++ b/old-ada/ada-xref.el @@ -0,0 +1,2359 @@ +;; ada-xref.el --- for lookup and completion in Ada mode + +;; Copyright (C) 1994-2019 Free Software Foundation, Inc. + +;; Author: Markus Heritsch +;; Rolf Ebert +;; Emmanuel Briot +;; Maintainer: Stephen Leake +;; Keywords: languages ada xref +;; Package: ada-mode + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This Package provides a set of functions to use the output of the +;; cross reference capabilities of the GNAT Ada compiler +;; for lookup and completion in Ada mode. +;; +;; If a file *.`adp' exists in the ada-file directory, then it is +;; read for configuration information. It is read only the first +;; time a cross-reference is asked for, and is not read later. + +;;; Code: + +;; ----- Requirements ----------------------------------------------------- + +(require 'compile) +(require 'comint) +(require 'find-file) +(require 'ada-mode) +(eval-when-compile (require 'cl-lib)) + +;; ------ User variables +(defcustom ada-xref-other-buffer t + "If nil, always display the cross-references in the same buffer. +Otherwise create either a new buffer or a new frame." + :type 'boolean :group 'ada) + +(defcustom ada-xref-create-ali nil + "If non-nil, run gcc whenever the cross-references are not up-to-date. +If nil, the cross-reference mode never runs gcc." + :type 'boolean :group 'ada) + +(defcustom ada-xref-confirm-compile nil + "If non-nil, ask for confirmation before compiling or running the application." + :type 'boolean :group 'ada) + +(defcustom ada-krunch-args "0" + "Maximum number of characters for filenames created by `gnatkr'. +Set to 0, if you don't use crunched filenames. This should be a string." + :type 'string :group 'ada) + +(defcustom ada-gnat-cmd "gnat" + "Default GNAT project file parser. +Will be run with args \"list -v -Pfile.gpr\". +Default is standard GNAT distribution; alternate \"gnatpath\" +is faster, available from Ada mode web site." + :type 'string :group 'ada) + +(defcustom ada-gnatls-args '("-v") + "Arguments to pass to `gnatls' to find location of the runtime. +Typical use is to pass `--RTS=soft-floats' on some systems that support it. + +You can also add `-I-' if you do not want the current directory to be included. +Otherwise, going from specs to bodies and back will first look for files in the +current directory. This only has an impact if you are not using project files, +but only ADA_INCLUDE_PATH." + :type '(repeat string) :group 'ada) + +(defcustom ada-prj-default-comp-opt "-gnatq -gnatQ" + "Default compilation options." + :type 'string :group 'ada) + +(defcustom ada-prj-default-bind-opt "" + "Default binder options." + :type 'string :group 'ada) + +(defcustom ada-prj-default-link-opt "" + "Default linker options." + :type 'string :group 'ada) + +(defcustom ada-prj-default-gnatmake-opt "-g" + "Default options for `gnatmake'." + :type 'string :group 'ada) + +(defcustom ada-prj-default-gpr-file "" + "Default GNAT project file. +If non-empty, this file is parsed to set the source and object directories for +the Ada mode project." + :type 'string :group 'ada) + +(defcustom ada-prj-ada-project-path-sep + (cond ((boundp 'path-separator) path-separator) ; 20.3+ + ((memq system-type '(windows-nt ms-dos)) ";") + (t ":")) + "Default separator for ada_project_path project variable." + :type 'string :group 'ada) + +(defcustom ada-prj-gnatfind-switches "-rf" + "Default switches to use for `gnatfind'. +You should modify this variable, for instance to add `-a', if you are working +in an environment where most ALI files are write-protected. +The command `gnatfind' is used every time you choose the menu +\"Show all references\"." + :type 'string :group 'ada) + +(defcustom ada-prj-default-check-cmd + (concat "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current}" + " -cargs ${comp_opt}") + "Default command to be used to compile a single file. +Emacs will substitute the current filename for ${full_current}, or add +the filename at the end. This is the same syntax as in the project file." + :type 'string :group 'ada) + +(defcustom ada-prj-default-comp-cmd + (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs" + " ${comp_opt}") + "Default command to be used to compile a single file. +Emacs will substitute the current filename for ${full_current}, or add +the filename at the end. This is the same syntax as in the project file." + :type 'string :group 'ada) + +(defcustom ada-prj-default-debugger "${cross_prefix}gdb" + "Default name of the debugger." + :type 'string :group 'ada) + +(defcustom ada-prj-default-make-cmd + (concat "${cross_prefix}gnatmake -o ${main} ${main} ${gnatmake_opt} " + "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}") + "Default command to be used to compile the application. +This is the same syntax as in the project file." + :type 'string :group 'ada) + +(defcustom ada-prj-default-project-file "" + "Name of the current project file. +Emacs will not try to use the search algorithm to find the project file if +this string is not empty. It is set whenever a project file is found." + :type '(file :must-match t) :group 'ada) + +(defcustom ada-gnatstub-opts "-q -I${src_dir}" + "Options to pass to `gnatsub' to generate the body of a package. +This has the same syntax as in the project file (with variable substitution)." + :type 'string :group 'ada) + +(defcustom ada-always-ask-project nil + "If nil, use default values when no project file was found. +Otherwise, ask the user for the name of the project file to use." + :type 'boolean :group 'ada) + +(defconst ada-on-ms-windows (memq system-type '(windows-nt)) + "True if we are running on Windows.") + +(defcustom ada-tight-gvd-integration nil + "If non-nil, a new Emacs frame will be swallowed in GVD when debugging. +If GVD is not the debugger used, nothing happens." + :type 'boolean :group 'ada) + +(defcustom ada-xref-search-with-egrep t + "If non-nil, use grep -E to find the possible declarations for an entity. +This alternate method is used when the exact location was not found in the +information provided by GNAT. However, it might be expensive if you have a lot +of sources, since it will search in all the files in your project." + :type 'boolean :group 'ada) + +(defvar ada-load-project-hook nil + "Hook that is run when loading a project file. +Each function in this hook takes one argument FILENAME, that is the name of +the project file to load. +This hook should be used to support new formats for the project files. + +If the function can load the file with the given filename, it should create a +buffer that contains a conversion of the file to the standard format of the +project files, and return that buffer. (The usual \"src_dir=\" or \"obj_dir=\" +lines.) It should return nil if it doesn't know how to convert that project +file.") + + +;; ------- Nothing to be modified by the user below this +(defvar ada-last-prj-file "" + "Name of the last project file entered by the user.") + +(defconst ada-prj-file-extension ".adp" + "The extension used for project files.") + +(defvar ada-xref-runtime-library-specs-path '() + "Directories where the specs for the standard library is found. +This is used for cross-references.") + +(defvar ada-xref-runtime-library-ali-path '() + "Directories where the ali for the standard library is found. +This is used for cross-references.") + +(defvar ada-xref-pos-ring '() + "List of positions selected by the cross-references functions. +Used to go back to these positions.") + +(defvar ada-cd-command + (if (string-match "cmdproxy.exe" shell-file-name) + "cd /d" + "cd") + "Command to use to change to a specific directory. +On Windows systems using `cmdproxy.exe' as the shell, +we need to use `/d' or the drive is never changed.") + +(defvar ada-command-separator (if ada-on-ms-windows " && " "\n") + "Separator to use between multiple commands to `compile' or `start-process'. +`cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use +\"&&\" for now.") + +(defconst ada-xref-pos-ring-max 16 + "Number of positions kept in the list `ada-xref-pos-ring'.") + +(defvar ada-operator-re + "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>" + "Regexp to match for operators.") + +(defvar ada-xref-project-files '() + "Associative list of project files with properties. +It has the format: (project project ...) +A project has the format: (project-file . project-plist) +\(See `apropos plist' for operations on property lists). +See `ada-default-prj-properties' for the list of valid properties. +The current project is retrieved with `ada-xref-current-project'. +Properties are retrieved with `ada-xref-get-project-field', set with +`ada-xref-set-project-field'. If project properties are accessed with no +project file, a (nil . default-properties) entry is created.") + + +;; ----- Identlist manipulation ------------------------------------------- +;; An identlist is a vector that is used internally to reference an identifier +;; To facilitate its use, we provide the following macros + +(defmacro ada-make-identlist () (make-vector 8 nil)) +(defmacro ada-name-of (identlist) (list 'aref identlist 0)) +(defmacro ada-line-of (identlist) (list 'aref identlist 1)) +(defmacro ada-column-of (identlist) (list 'aref identlist 2)) +(defmacro ada-file-of (identlist) (list 'aref identlist 3)) +(defmacro ada-ali-index-of (identlist) (list 'aref identlist 4)) +(defmacro ada-declare-file-of (identlist) (list 'aref identlist 5)) +(defmacro ada-references-of (identlist) (list 'aref identlist 6)) +(defmacro ada-on-declaration (identlist) (list 'aref identlist 7)) + +(defmacro ada-set-name (identlist name) (list 'aset identlist 0 name)) +(defmacro ada-set-line (identlist line) (list 'aset identlist 1 line)) +(defmacro ada-set-column (identlist col) (list 'aset identlist 2 col)) +(defmacro ada-set-file (identlist file) (list 'aset identlist 3 file)) +(defmacro ada-set-ali-index (identlist index) (list 'aset identlist 4 index)) +(defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file)) +(defmacro ada-set-references (identlist ref) (list 'aset identlist 6 ref)) +(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value)) + +(defsubst ada-get-ali-buffer (file) + "Read the ali file FILE into a new buffer, and return the buffer's name." + (find-file-noselect (ada-get-ali-file-name file))) + + +;; ----------------------------------------------------------------------- + +(defun ada-quote-cmd (cmd) + "Duplicate all `\\' characters in CMD so that it can be passed to `compile'." + (mapconcat 'identity (split-string cmd "\\\\") "\\\\")) + +(defun ada-find-executable (exec-name) + "Find the full path to the executable file EXEC-NAME. +If not found, throw an error. +On Windows systems, this will properly handle .exe extension as well." + (let ((result (or (ada-find-file-in-dir exec-name exec-path) + (ada-find-file-in-dir (concat exec-name ".exe") exec-path)))) + (if result + result + (error "`%s' not found in path" exec-name)))) + +(defun ada-initialize-runtime-library (cross-prefix) + "Initialize the variables for the runtime library location. +CROSS-PREFIX is the prefix to use for the `gnatls' command." + (let ((gnatls + (condition-case nil + ;; if gnatls not found, just give up (may not be using GNAT) + (ada-find-executable (concat cross-prefix "gnatls")) + (error nil)))) + (if gnatls + (save-excursion + (setq ada-xref-runtime-library-specs-path '() + ada-xref-runtime-library-ali-path '()) + (set-buffer (get-buffer-create "*gnatls*")) + (widen) + (erase-buffer) + ;; Even if we get an error, delete the *gnatls* buffer + (unwind-protect + (let ((status (apply 'call-process gnatls (append '(nil t nil) ada-gnatls-args)))) + (goto-char (point-min)) + + ;; Since we didn't provide all the inputs gnatls expects, it returns status 4 + (if (/= 4 status) + (error (buffer-substring (point) (line-end-position)))) + + ;; Source path + + (search-forward "Source Search Path:") + (forward-line 1) + (while (not (looking-at "^$")) + (back-to-indentation) + (add-to-list 'ada-xref-runtime-library-specs-path + (if (looking-at "") + "." + (buffer-substring-no-properties + (point) + (point-at-eol)))) + (forward-line 1)) + + ;; Object path + + (search-forward "Object Search Path:") + (forward-line 1) + (while (not (looking-at "^$")) + (back-to-indentation) + (add-to-list 'ada-xref-runtime-library-ali-path + (if (looking-at "") + "." + (buffer-substring-no-properties + (point) + (point-at-eol)))) + (forward-line 1)) + ) + (kill-buffer nil)))) + + (setq ada-xref-runtime-library-specs-path + (reverse ada-xref-runtime-library-specs-path)) + (setq ada-xref-runtime-library-ali-path + (reverse ada-xref-runtime-library-ali-path)) + )) + +(defun ada-gnat-parse-gpr (plist gpr-file) + "Set gpr_file, src_dir and obj_dir properties in PLIST by parsing GPR-FILE. +Return new value of PLIST. +GPR_FILE must be full path to file, normalized. +src_dir, obj_dir will include compiler runtime. +Assumes environment variable ADA_PROJECT_PATH is set properly." + (with-current-buffer (get-buffer-create "*gnatls*") + (erase-buffer) + + ;; this can take a long time; let the user know what's up + (message "Parsing %s ..." gpr-file) + + ;; Even if we get an error, delete the *gnatls* buffer + (unwind-protect + (let* ((cross-prefix (plist-get plist 'cross_prefix)) + (gnat (concat cross-prefix ada-gnat-cmd)) + ;; Putting quotes around gpr-file confuses gnatpath on Lynx; not clear why + (gpr-opt (concat "-P" gpr-file)) + (src-dir '()) + (obj-dir '()) + (status (call-process gnat nil t nil "list" "-v" gpr-opt))) + (goto-char (point-min)) + + (if (/= 0 status) + (error (buffer-substring (point) (line-end-position)))) + + ;; Source path + + (search-forward "Source Search Path:") + (forward-line 1) ; first directory in list + (while (not (looking-at "^$")) ; terminate on blank line + (back-to-indentation) ; skip whitespace + (cl-pushnew (if (looking-at "") + default-directory + (expand-file-name + (buffer-substring-no-properties + (point) (line-end-position)))) + src-dir :test #'equal) + (forward-line 1)) + + ;; Object path + + (search-forward "Object Search Path:") + (forward-line 1) + (while (not (looking-at "^$")) + (back-to-indentation) + (cl-pushnew (if (looking-at "") + default-directory + (expand-file-name + (buffer-substring-no-properties + (point) (line-end-position)))) + obj-dir :test #'equal) + (forward-line 1)) + + ;; Set properties + (setq plist (plist-put plist 'gpr_file gpr-file)) + (setq plist (plist-put plist 'src_dir src-dir)) + (plist-put plist 'obj_dir obj-dir) + ) + (kill-buffer nil) + (message "Parsing %s ... done" gpr-file) + ) + )) + +(defun ada-treat-cmd-string (cmd-string) + "Replace variable references ${var} in CMD-STRING with the appropriate value. +Also replace standard environment variables $var. +Assumes project exists. +As a special case, ${current} is replaced with the name of the current +file, minus extension but with directory, and ${full_current} is +replaced by the name including the extension." + + (while (string-match "\\(-[^-$IO]*[IO]\\)?\\${\\([^}]+\\)}" cmd-string) + (let (value + (name (match-string 2 cmd-string))) + (cond + ((string= name "current") + (setq value (file-name-sans-extension (buffer-file-name)))) + ((string= name "full_current") + (setq value (buffer-file-name))) + (t + (save-match-data + (setq value (ada-xref-get-project-field (intern name)))))) + + ;; Check if there is an environment variable with the same name + (if (null value) + (if (not (setq value (getenv name))) + (message "%s" (concat "No project or environment variable " name " found")))) + + (cond + ((null value) + (setq cmd-string (replace-match "" t t cmd-string))) + ((stringp value) + (setq cmd-string (replace-match value t t cmd-string))) + ((listp value) + (let ((prefix (match-string 1 cmd-string))) + (setq cmd-string (replace-match + (mapconcat (lambda(x) (concat prefix x)) value " ") + t t cmd-string))))) + )) + (substitute-in-file-name cmd-string)) + + +(defun ada-xref-get-project-field (field) + "Extract the value of FIELD from the current project file. +Project variables are substituted. + +Note that for src_dir and obj_dir, you should rather use +`ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field' +which will in addition return the default paths." + + (let* ((project-plist (cdr (ada-xref-current-project))) + (value (plist-get project-plist field))) + + (cond + ((eq field 'gnatmake_opt) + (let ((gpr-file (plist-get project-plist 'gpr_file))) + (if (not (string= gpr-file "")) + (setq value (concat "-P\"" gpr-file "\" " value))))) + + ;; FIXME: check for src_dir, obj_dir here, rather than requiring user to do it + (t + nil)) + + ;; Substitute the ${...} constructs in all the strings, including + ;; inside lists + (cond + ((stringp value) + (ada-treat-cmd-string value)) + ((null value) + nil) + ((listp value) + (mapcar (lambda(x) (if x (ada-treat-cmd-string x) x)) value)) + (t + value) + ) + )) + +(defun ada-xref-get-src-dir-field () + "Return the full value for src_dir, including the default directories. +All the directories are returned as absolute directories." + + (let ((build-dir (ada-xref-get-project-field 'build_dir))) + (append + ;; Add ${build_dir} in front of the path + (list build-dir) + + (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir) + build-dir) + + ;; Add the standard runtime at the end + ada-xref-runtime-library-specs-path))) + +(defun ada-xref-get-obj-dir-field () + "Return the full value for obj_dir, including the default directories. +All the directories are returned as absolute directories." + + (let ((build-dir (ada-xref-get-project-field 'build_dir))) + (append + ;; Add ${build_dir} in front of the path + (list build-dir) + + (ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir) + build-dir) + + ;; Add the standard runtime at the end + ada-xref-runtime-library-ali-path))) + +(defun ada-xref-set-project-field (field value) + "Set FIELD to VALUE in current project. Assumes project exists." + ;; same algorithm to find project-plist as ada-xref-current-project + (let* ((file-name (ada-xref-current-project-file)) + (project-plist (cdr (assoc file-name ada-xref-project-files)))) + + (setq project-plist (plist-put project-plist field value)) + (setcdr (assoc file-name ada-xref-project-files) project-plist))) + +(defun ada-xref-update-project-menu () + "Update the menu Ada->Project, with the list of available project files." + ;; Create the standard items. + (let ((submenu + `("Project" + ["Load..." ada-set-default-project-file t] + ["New..." ada-prj-new t] + ["Edit..." ada-prj-edit t] + "---" + ;; Add the project files + ,@(mapcar + (lambda (x) + (let* ((name (or (car x) "")) + (command `(lambda () + "Select the current project file." + (interactive) + (ada-select-prj-file ,name)))) + (vector + (file-name-nondirectory name) + command + :button (cons + :toggle + (equal ada-prj-default-project-file + (car x)) + )))) + + (or ada-xref-project-files '(nil)))))) + + (easy-menu-add-item ada-mode-menu '() submenu))) + + +;;------------------------------------------------------------- +;;-- Searching a file anywhere on the source path. +;;-- +;;-- The following functions provide support for finding a file anywhere +;;-- on the source path, without providing an explicit directory. +;;-- They also provide file name completion in the minibuffer. +;;-- +;;-- Public subprograms: ada-find-file +;;-- +;;------------------------------------------------------------- + +(defun ada-do-file-completion (string predicate flag) + "Completion function when reading a file from the minibuffer. +Completion is attempted in all the directories in the source path, +as defined in the project file." + ;; FIXME: doc arguments + + ;; This function is not itself interactive, but it is called as part + ;; of the prompt of interactive functions, so we require a project + ;; file. + (ada-require-project-file) + (let (list + (dirs (ada-xref-get-src-dir-field))) + + (while dirs + (if (file-directory-p (car dirs)) + (setq list (append list (file-name-all-completions string (car dirs))))) + (setq dirs (cdr dirs))) + (cond ((equal flag 'lambda) + (assoc string list)) + (flag + list) + (t + (try-completion string + (mapcar (lambda (x) (cons x 1)) list) + predicate))))) + +;;;###autoload +(defun ada-find-file (filename) + "Open FILENAME, from anywhere in the source path. +Completion is available." + (interactive + (list (completing-read "File: " 'ada-do-file-completion))) + (let ((file (ada-find-src-file-in-dir filename))) + (if file + (find-file file) + (error "%s not found in src_dir" filename)))) + + +;; ----- Utilities ------------------------------------------------- + +(defun ada-require-project-file () + "If the current project does not exist, load or create a default one. +Should only be called from interactive functions." + (if (string= "" ada-prj-default-project-file) + (ada-reread-prj-file (ada-prj-find-prj-file t)))) + +(defun ada-xref-current-project-file () + "Return the current project file name; never nil. +Call `ada-require-project-file' first if a project must exist." + (if (not (string= "" ada-prj-default-project-file)) + ada-prj-default-project-file + (ada-prj-find-prj-file t))) + +(defun ada-xref-current-project () + "Return the current project. +Call `ada-require-project-file' first to ensure a project exists." + (let ((file-name (ada-xref-current-project-file))) + (assoc file-name ada-xref-project-files))) + +(defun ada-show-current-project () + "Display current project file name in message buffer." + (interactive) + (message (ada-xref-current-project-file))) + +(defun ada-show-current-main () + "Display current main file name in message buffer." + (interactive) + (message "ada-mode main: %s" (ada-xref-get-project-field 'main))) + +(defun ada-xref-push-pos (filename position) + "Push (FILENAME, POSITION) on the position ring for cross-references." + (setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring)) + (if (> (length ada-xref-pos-ring) ada-xref-pos-ring-max) + (setcdr (nthcdr (1- ada-xref-pos-ring-max) ada-xref-pos-ring) nil))) + +(defun ada-xref-goto-previous-reference () + "Go to the previous cross-reference we were on." + (interactive) + (if ada-xref-pos-ring + (let ((pos (car ada-xref-pos-ring))) + (setq ada-xref-pos-ring (cdr ada-xref-pos-ring)) + (find-file (car (cdr pos))) + (goto-char (car pos))))) + +(defun ada-set-default-project-file (file) + "Set FILE as the current project file." + (interactive "fProject file:") + (ada-parse-prj-file file) + (ada-select-prj-file file)) + +;; ------ Handling the project file ----------------------------- + +(defun ada-prj-find-prj-file (&optional no-user-question) + "Find the project file associated with the current buffer. +If the buffer is not in Ada mode, or not associated with a file, +return `ada-prj-default-project-file'. Otherwise, search for a file with +the same base name as the Ada file, but extension given by +`ada-prj-file-extension' (default .adp). If not found, search for *.adp +in the current directory; if several are found, and NO-USER-QUESTION +is non-nil, prompt the user to select one. If none are found, return +\"default.adp\"." + + (let (selected) + + (if (not (and (derived-mode-p 'ada-mode) + buffer-file-name)) + + ;; Not in an Ada buffer, or current buffer not associated + ;; with a file (for instance an emerge buffer) + (setq selected nil) + + ;; other cases: use a more complex algorithm + + (let* ((current-file (buffer-file-name)) + (first-choice (concat + (file-name-sans-extension current-file) + ada-prj-file-extension)) + (dir (file-name-directory current-file)) + + (prj-files (directory-files + dir t + (concat ".*" (regexp-quote + ada-prj-file-extension) "$"))) + (choice nil)) + + (cond + + ((file-exists-p first-choice) + ;; filename.adp + (setq selected first-choice)) + + ((= (length prj-files) 1) + ;; Exactly one project file was found in the current directory + (setq selected (car prj-files))) + + ((and (> (length prj-files) 1) (not no-user-question)) + ;; multiple project files in current directory, ask the user + (save-window-excursion + (with-output-to-temp-buffer "*choice list*" + (princ "There are more than one possible project file.\n") + (princ "Which one should we use ?\n\n") + (princ " no. file name \n") + (princ " --- ------------------------\n") + (let ((counter 1)) + (while (<= counter (length prj-files)) + (princ (format " %2d) %s\n" + counter + (nth (1- counter) prj-files))) + (setq counter (1+ counter)) + + ))) ; end of with-output-to ... + (setq choice nil) + (while (or + (not choice) + (not (integerp choice)) + (< choice 1) + (> choice (length prj-files))) + (setq choice (string-to-number + (read-from-minibuffer "Enter No. of your choice: ")))) + (setq selected (nth (1- choice) prj-files)))) + + ((= (length prj-files) 0) + ;; No project file in the current directory; ask user + (unless (or no-user-question (not ada-always-ask-project)) + (setq ada-last-prj-file + (read-file-name + (concat "project file [" ada-last-prj-file "]:") + nil ada-last-prj-file)) + (unless (string= ada-last-prj-file "") + (setq selected ada-last-prj-file)))) + ))) + + (or selected "default.adp") + )) + +(defun ada-default-prj-properties () + "Return the default project properties list with the current buffer as main." + + (let ((file (buffer-file-name nil))) + (list + ;; variable name alphabetical order + 'ada_project_path (or (getenv "ADA_PROJECT_PATH") "") + 'ada_project_path_sep ada-prj-ada-project-path-sep + 'bind_opt ada-prj-default-bind-opt + 'build_dir default-directory + 'casing (if (listp ada-case-exception-file) + ada-case-exception-file + (list ada-case-exception-file)) + 'check_cmd (list ada-prj-default-check-cmd) ;; FIXME: should not a list + 'comp_cmd (list ada-prj-default-comp-cmd) ;; FIXME: should not a list + 'comp_opt ada-prj-default-comp-opt + 'cross_prefix "" + 'debug_cmd (concat ada-prj-default-debugger + " ${main}" (if ada-on-ms-windows ".exe")) ;; FIXME: don't need .exe? + 'debug_post_cmd (list nil) + 'debug_pre_cmd (list (concat ada-cd-command " ${build_dir}")) + 'gnatmake_opt ada-prj-default-gnatmake-opt + 'gnatfind_opt ada-prj-gnatfind-switches + 'gpr_file ada-prj-default-gpr-file + 'link_opt ada-prj-default-link-opt + 'main (if file + (file-name-nondirectory + (file-name-sans-extension file)) + "") + 'make_cmd (list ada-prj-default-make-cmd) ;; FIXME: should not a list + 'obj_dir (list ".") + 'remote_machine "" + 'run_cmd (list (concat "./${main}" (if ada-on-ms-windows ".exe"))) + ;; FIXME: should not a list + ;; FIXME: don't need .exe? + 'src_dir (list ".") + ))) + +(defun ada-parse-prj-file (prj-file) + "Read PRJ-FILE, set project properties in `ada-xref-project-files'." + (let ((project (ada-default-prj-properties))) + + (setq prj-file (expand-file-name prj-file)) + (if (string= (file-name-extension prj-file) "gpr") + (setq project (ada-gnat-parse-gpr project prj-file)) + + (setq project (ada-parse-prj-file-1 prj-file project)) + ) + + ;; Store the project properties + (if (assoc prj-file ada-xref-project-files) + (setcdr (assoc prj-file ada-xref-project-files) project) + (add-to-list 'ada-xref-project-files (cons prj-file project))) + + (ada-xref-update-project-menu) + )) + +(defun ada-parse-prj-file-1 (prj-file project) + "Parse the Ada mode project file PRJ-FILE, set project properties in PROJECT. +Return new value of PROJECT." + (let ((ada-buffer (current-buffer)) + ;; fields that are lists or otherwise require special processing + ada_project_path casing comp_cmd check_cmd + debug_pre_cmd debug_post_cmd gpr_file make_cmd obj_dir src_dir run_cmd) + + ;; Give users a chance to use compiler-specific project file formats + (let ((buffer (run-hook-with-args-until-success + 'ada-load-project-hook prj-file))) + (unless buffer + ;; we load the project file with no warnings; if it does not + ;; exist, we stay in the Ada buffer; no project variable + ;; settings will be found. That works for the default + ;; "default.adp", which does not exist as a file. + (setq buffer (find-file-noselect prj-file nil))) + (set-buffer buffer)) + + (widen) + (goto-char (point-min)) + + ;; process each line + (while (not (eobp)) + + ;; ignore lines that don't have the format "name=value", put + ;; 'name', 'value' in match-string. + (if (looking-at "^\\([^=\n]+\\)=\\(.*\\)") + (cond + ;; FIXME: strip trailing spaces + ;; variable name alphabetical order + ((string= (match-string 1) "ada_project_path") + (cl-pushnew (expand-file-name + (substitute-in-file-name (match-string 2))) + ada_project_path :test #'equal)) + + ((string= (match-string 1) "build_dir") + (setq project + (plist-put project 'build_dir + (file-name-as-directory (match-string 2))))) + + ((string= (match-string 1) "casing") + (cl-pushnew (expand-file-name (substitute-in-file-name (match-string 2))) + casing :test #'equal)) + + ((string= (match-string 1) "check_cmd") + (cl-pushnew (match-string 2) check_cmd :test #'equal)) + + ((string= (match-string 1) "comp_cmd") + (cl-pushnew (match-string 2) comp_cmd :test #'equal)) + + ((string= (match-string 1) "debug_post_cmd") + (cl-pushnew (match-string 2) debug_post_cmd :test #'equal)) + + ((string= (match-string 1) "debug_pre_cmd") + (cl-pushnew (match-string 2) debug_pre_cmd :test #'equal)) + + ((string= (match-string 1) "gpr_file") + ;; expand now; path is relative to Emacs project file + (setq gpr_file (expand-file-name (match-string 2)))) + + ((string= (match-string 1) "make_cmd") + (cl-pushnew (match-string 2) make_cmd :test #'equal)) + + ((string= (match-string 1) "obj_dir") + (cl-pushnew (file-name-as-directory + (expand-file-name (match-string 2))) + obj_dir :test #'equal)) + + ((string= (match-string 1) "run_cmd") + (cl-pushnew (match-string 2) run_cmd :test #'equal)) + + ((string= (match-string 1) "src_dir") + (cl-pushnew (file-name-as-directory + (expand-file-name (match-string 2))) + src_dir :test #'equal)) + + (t + ;; any other field in the file is just copied + (setq project (plist-put project + (intern (match-string 1)) + (match-string 2)))))) + + (forward-line 1)) + + ;; done reading file + + ;; back to the user buffer + (set-buffer ada-buffer) + + ;; process accumulated lists + (if ada_project_path + (let ((sep (plist-get project 'ada_project_path_sep))) + (setq ada_project_path (reverse ada_project_path)) + (setq ada_project_path (mapconcat 'identity ada_project_path sep)) + (setq project (plist-put project 'ada_project_path ada_project_path)) + ;; env var needed now for ada-gnat-parse-gpr + (setenv "ADA_PROJECT_PATH" ada_project_path))) + + (if debug_post_cmd (setq project (plist-put project 'debug_post_cmd (reverse debug_post_cmd)))) + (if debug_pre_cmd (setq project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd)))) + (if casing (setq project (plist-put project 'casing (reverse casing)))) + (if check_cmd (setq project (plist-put project 'check_cmd (reverse check_cmd)))) + (if comp_cmd (setq project (plist-put project 'comp_cmd (reverse comp_cmd)))) + (if make_cmd (setq project (plist-put project 'make_cmd (reverse make_cmd)))) + (if run_cmd (setq project (plist-put project 'run_cmd (reverse run_cmd)))) + + (if gpr_file + (progn + (setq project (ada-gnat-parse-gpr project gpr_file)) + ;; append Ada source and object directories to others from Emacs project file + (setq src_dir (append (plist-get project 'src_dir) src_dir)) + (setq obj_dir (append (plist-get project 'obj_dir) obj_dir)) + (setq ada-xref-runtime-library-specs-path '() + ada-xref-runtime-library-ali-path '())) + ) + + ;; FIXME: gnatpath.exe doesn't output the runtime libraries, so always call ada-initialize-runtime-library + ;; if using a gpr_file, the runtime library directories are + ;; included in src_dir and obj_dir; otherwise they are in the + ;; 'runtime-library' variables. + ;; FIXME: always append to src_dir, obj_dir + (ada-initialize-runtime-library (or (ada-xref-get-project-field 'cross_prefix) "")) + ;;) + + (if obj_dir (setq project (plist-put project 'obj_dir (reverse obj_dir)))) + (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir)))) + + project + )) + +(defun ada-select-prj-file (file) + "Select FILE as the current project file." + (interactive) + (setq ada-prj-default-project-file (expand-file-name file)) + + (let ((casing (ada-xref-get-project-field 'casing))) + (if casing + (progn + ;; FIXME: use ada-get-absolute-dir here + (setq ada-case-exception-file casing) + (ada-case-read-exceptions)))) + + (let ((ada_project_path (ada-xref-get-project-field 'ada_project_path))) + (if ada_project_path + ;; FIXME: use ada-get-absolute-dir, mapconcat here + (setenv "ADA_PROJECT_PATH" ada_project_path))) + + (setq compilation-search-path (ada-xref-get-src-dir-field)) + + (setq ada-search-directories-internal + ;; FIXME: why do we need directory-file-name here? + (append (mapcar 'directory-file-name compilation-search-path) + ada-search-directories)) + + ;; return t, for decent display in message buffer when called interactively + t) + +(defun ada-find-references (&optional pos arg local-only) + "Find all references to the entity under POS. +Calls gnatfind to find the references. +If ARG is non-nil, the contents of the old *gnatfind* buffer is preserved. +If LOCAL-ONLY is non-nil, only declarations in the current file are returned." + (interactive "d\nP") + (ada-require-project-file) + + (let* ((identlist (ada-read-identifier pos)) + (alifile (ada-get-ali-file-name (ada-file-of identlist))) + (process-environment (ada-set-environment))) + + (set-buffer (get-file-buffer (ada-file-of identlist))) + + ;; if the file is more recent than the executable + (if (or (buffer-modified-p (current-buffer)) + (file-newer-than-file-p (ada-file-of identlist) alifile)) + (ada-find-any-references (ada-name-of identlist) + (ada-file-of identlist) + nil nil local-only arg) + (ada-find-any-references (ada-name-of identlist) + (ada-file-of identlist) + (ada-line-of identlist) + (ada-column-of identlist) local-only arg))) + ) + +(defun ada-find-local-references (&optional pos arg) + "Find all references to the entity under POS. +Calls `gnatfind' to find the references. +If ARG is non-nil, the contents of the old *gnatfind* buffer is preserved." + (interactive "d\nP") + (ada-find-references pos arg t)) + +(defconst ada-gnatfind-buffer-name "*gnatfind*") + +(defun ada-find-any-references + (entity &optional file line column local-only append) + "Search for references to any entity whose name is ENTITY. +ENTITY was first found the location given by FILE, LINE and COLUMN. +If LOCAL-ONLY is non-nil, then list only the references in FILE, +which is much faster. +If APPEND is non-nil, then append the output of the command to the +existing buffer `*gnatfind*', if there is one." + (interactive "sEntity name: ") + (ada-require-project-file) + + ;; Prepare the gnatfind command. Note that we must protect the quotes + ;; around operators, so that they are correctly handled and can be + ;; processed (gnatfind \"+\":...). + (let* ((quote-entity + (if (= (aref entity 0) ?\") + (if ada-on-ms-windows + (concat "\\\"" (substring entity 1 -1) "\\\"") + (concat "'\"" (substring entity 1 -1) "\"'")) + entity)) + (switches (ada-xref-get-project-field 'gnatfind_opt)) + ;; FIXME: use gpr_file + (cross-prefix (ada-xref-get-project-field 'cross_prefix)) + (command (concat cross-prefix "gnat find " switches " " + quote-entity + (if file (concat ":" (file-name-nondirectory file))) + (if line (concat ":" line)) + (if column (concat ":" column)) + (if local-only (concat " " (file-name-nondirectory file))) + )) + old-contents) + + ;; If a project file is defined, use it + (if (and ada-prj-default-project-file + (not (string= ada-prj-default-project-file ""))) + (if (string-equal (file-name-extension ada-prj-default-project-file) + "gpr") + (setq command (concat command " -P\"" ada-prj-default-project-file "\"")) + (setq command (concat command " -p\"" ada-prj-default-project-file "\"")))) + + (if (and append (get-buffer ada-gnatfind-buffer-name)) + (with-current-buffer "*gnatfind*" + (setq old-contents (buffer-string)))) + + (let ((compilation-error "reference")) + (compilation-start command 'compilation-mode (lambda (_mode) ada-gnatfind-buffer-name))) + + ;; Hide the "Compilation" menu + (with-current-buffer ada-gnatfind-buffer-name + (local-unset-key [menu-bar compilation-menu]) + + (if old-contents + (progn + (goto-char 1) + (setq buffer-read-only nil) + (insert old-contents) + (setq buffer-read-only t) + (goto-char (point-max))))) + ) + ) + +(defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file)) + +;; ----- Identifier Completion -------------------------------------------- +(defun ada-complete-identifier (pos) + "Try to complete the identifier around POS, using compiler cross-reference information." + (interactive "d") + (ada-require-project-file) + + ;; Initialize function-local variables and jump to the .ali buffer + ;; Note that for regexp search is case insensitive too + (let* ((curbuf (current-buffer)) + (identlist (ada-read-identifier pos)) + (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\(" + (regexp-quote (ada-name-of identlist)) + "[a-zA-Z0-9_]*\\)")) + (completed nil) + (symalist nil)) + + ;; Open the .ali file + (set-buffer (ada-get-ali-buffer (buffer-file-name))) + (goto-char (point-max)) + + ;; build an alist of possible completions + (while (re-search-backward sofar nil t) + (setq symalist (cons (cons (match-string 1) nil) symalist))) + + (setq completed (try-completion "" symalist)) + + ;; kills .ali buffer + (kill-buffer nil) + + ;; deletes the incomplete identifier in the buffer + (set-buffer curbuf) + (looking-at "[a-zA-Z0-9_]+") + (replace-match "") + ;; inserts the completed symbol + (insert completed) + )) + +;; ----- Cross-referencing ---------------------------------------- + +(defun ada-point-and-xref () + "Jump to the declaration of the entity below the cursor." + (interactive) + (mouse-set-point last-input-event) + (ada-goto-declaration (point))) + +(defun ada-point-and-xref-body () + "Jump to the body of the entity under the cursor." + (interactive) + (mouse-set-point last-input-event) + (ada-goto-body (point))) + +(defun ada-goto-body (pos &optional other-frame) + "Display the body of the entity around POS. +OTHER-FRAME non-nil means display in another frame. +If the entity doesn't have a body, display its declaration. +As a side effect, the buffer for the declaration is also open." + (interactive "d") + (ada-goto-declaration pos other-frame) + + ;; Temporarily force the display in the same buffer, since we + ;; already changed previously + (let ((ada-xref-other-buffer nil)) + (ada-goto-declaration (point) nil))) + +(defun ada-goto-declaration (pos &optional other-frame) + "Display the declaration of the identifier around POS. +The declaration is shown in another buffer if `ada-xref-other-buffer' is +non-nil. +If OTHER-FRAME is non-nil, display the cross-reference in another frame." + (interactive "d") + (ada-require-project-file) + (push-mark pos) + (ada-xref-push-pos (buffer-file-name) pos) + + ;; First try the standard algorithm by looking into the .ali file, but if + ;; that file was too old or even did not exist, try to look in the whole + ;; object path for a possible location. + (let ((identlist (ada-read-identifier pos))) + (condition-case err + (ada-find-in-ali identlist other-frame) + ;; File not found: print explicit error message + (ada-error-file-not-found + (message "%s%s" (error-message-string err) (nthcdr 1 err))) + + (error + (let ((ali-file (ada-get-ali-file-name (ada-file-of identlist)))) + + ;; If the ALI file was up-to-date, then we probably have a predefined + ;; entity, whose references are not given by GNAT + (if (and (file-exists-p ali-file) + (file-newer-than-file-p ali-file (ada-file-of identlist))) + (message "No cross-reference found -- may be a predefined entity.") + + ;; Else, look in every ALI file, except if the user doesn't want that + (if ada-xref-search-with-egrep + (ada-find-in-src-path identlist other-frame) + (message "Cross-referencing information is not up-to-date; please recompile.") + ))))))) + +(defun ada-goto-declaration-other-frame (pos) + "Display the declaration of the identifier around POS. +The declaration is shown in another frame if `ada-xref-other-buffer' is +non-nil." + (interactive "d") + (ada-goto-declaration pos t)) + +(defun ada-remote (command) + "Return the remote version of COMMAND, or COMMAND if remote_machine is nil." + (let ((machine (ada-xref-get-project-field 'remote_machine))) + (if (or (not machine) (string= machine "")) + command + (format "%s %s '(%s)'" + remote-shell-program + machine + command)))) + +(defun ada-get-absolute-dir-list (dir-list root-dir) + "Return the list of absolute directories found in DIR-LIST. +If a directory is a relative directory, ROOT-DIR is prepended. +Project and environment variables are substituted." + (mapcar (lambda (x) (expand-file-name x (ada-treat-cmd-string root-dir))) dir-list)) + +(defun ada-set-environment () + "Prepare an environment for Ada compilation. +This returns a new value to use for `process-environment', +but does not actually put it into use. +It modifies the source path and object path with the values found in the +project file." + (let ((include (getenv "ADA_INCLUDE_PATH")) + (objects (getenv "ADA_OBJECTS_PATH")) + (build-dir (ada-xref-get-project-field 'build_dir))) + (if include + (setq include (concat path-separator include))) + (if objects + (setq objects (concat path-separator objects))) + (cons + (concat "ADA_INCLUDE_PATH=" + (mapconcat (lambda(x) (expand-file-name x build-dir)) + (ada-xref-get-project-field 'src_dir) + path-separator) + include) + (cons + (concat "ADA_OBJECTS_PATH=" + (mapconcat (lambda(x) (expand-file-name x build-dir)) + (ada-xref-get-project-field 'obj_dir) + path-separator) + objects) + process-environment)))) + +(defun ada-compile-application (&optional arg) + "Compile the application, using the command found in the project file. +If ARG is not nil, ask for user confirmation." + (interactive "P") + (ada-require-project-file) + (let ((cmd (ada-xref-get-project-field 'make_cmd)) + (process-environment (ada-set-environment)) + (compilation-scroll-output t)) + + (setq compilation-search-path (ada-xref-get-src-dir-field)) + + ;; If no project file was found, ask the user + (unless cmd + (setq cmd '("") arg t)) + + ;; Make a single command from the list of commands, including the + ;; commands to run it on a remote machine. + (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) + + (if (or ada-xref-confirm-compile arg) + (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) + + ;; Insert newlines so as to separate the name of the commands to run + ;; and the output of the commands. This doesn't work with cmdproxy.exe, + ;; which gets confused by newline characters. + (if (not (string-match ".exe" shell-file-name)) + (setq cmd (concat cmd "\n\n"))) + + (compile (ada-quote-cmd cmd)))) + +(defun ada-set-main-compile-application () + "Set main project variable to current buffer, build main." + (interactive) + (ada-require-project-file) + (let* ((file (buffer-file-name (current-buffer))) + main) + (if (not file) + (error "No file for current buffer") + + (setq main + (if file + (file-name-nondirectory + (file-name-sans-extension file)) + "")) + (ada-xref-set-project-field 'main main) + (ada-compile-application)))) + +(defun ada-compile-current (&optional arg prj-field) + "Recompile the current file. +If ARG is non-nil, ask for user confirmation of the command. +PRJ-FIELD is the name of the field to use in the project file to get the +command, and should be either `comp_cmd' (default) or `check_cmd'." + (interactive "P") + (ada-require-project-file) + (let* ((field (if prj-field prj-field 'comp_cmd)) + (cmd (ada-xref-get-project-field field)) + (process-environment (ada-set-environment)) + (compilation-scroll-output t)) + + (unless cmd + (setq cmd '("") arg t)) + + ;; Make a single command from the list of commands, including the + ;; commands to run it on a remote machine. + (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) + + ;; If no project file was found, ask the user + (if (or ada-xref-confirm-compile arg) + (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) + + (compile (ada-quote-cmd cmd)))) + +(defun ada-check-current (&optional arg) + "Check the current file for syntax errors. +If ARG is non-nil, ask for user confirmation of the command." + (interactive "P") + (ada-compile-current arg 'check_cmd)) + +(defun ada-run-application (&optional arg) + "Run the application. +If ARG is non-nil, ask for user confirmation." + (interactive) + (ada-require-project-file) + + (let ((machine (ada-xref-get-project-field 'cross_prefix))) + (if (and machine (not (string= machine ""))) + (error "This feature is not supported yet for cross environments"))) + + (let ((command (ada-xref-get-project-field 'run_cmd))) + + ;; Guess the command if it wasn't specified + (if (not command) + (setq command (list (file-name-sans-extension (buffer-name))))) + + ;; Modify the command to run remotely + (setq command (ada-remote (mapconcat 'identity command + ada-command-separator))) + + ;; Ask for the arguments to the command if required + (if (or ada-xref-confirm-compile arg) + (setq command (read-from-minibuffer "Enter command to execute: " + command))) + + ;; Run the command + (with-current-buffer (get-buffer-create "*run*") + (setq buffer-read-only nil) + + (erase-buffer) + (start-process "run" (current-buffer) shell-file-name + "-c" command) + (comint-mode) + ;; Set these two variables to their default values, since otherwise + ;; the output buffer is scrolled so that only the last output line + ;; is visible at the top of the buffer. + (set (make-local-variable 'scroll-step) 0) + (set (make-local-variable 'scroll-conservatively) 0) + ) + (display-buffer "*run*") + + ;; change to buffer *run* for interactive programs + (other-window 1) + (switch-to-buffer "*run*") + )) + +(defun ada-gdb-application (&optional arg executable-name) + "Start the debugger on the application. +If ARG is non-nil, ask the user to confirm the command. +EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the +project file." + (interactive "P") + (ada-require-project-file) + (let ((buffer (current-buffer)) + cmd pre-cmd post-cmd) + (setq cmd (if executable-name + (concat ada-prj-default-debugger " " executable-name) + (ada-xref-get-project-field 'debug_cmd)) + pre-cmd (ada-xref-get-project-field 'debug_pre_cmd) + post-cmd (ada-xref-get-project-field 'debug_post_cmd)) + + ;; If the command was not given in the project file, start a bare gdb + (if (not cmd) + (setq cmd (concat ada-prj-default-debugger + " " + (or executable-name + (file-name-sans-extension (buffer-file-name)))))) + + ;; For gvd, add an extra switch so that the Emacs window is completely + ;; swallowed inside the Gvd one + (if (and ada-tight-gvd-integration + (string-match "^[^ \t]*gvd" cmd)) + ;; Start a new frame, so that when gvd exists we do not kill Emacs + ;; We make sure that gvd swallows the new frame, not the one the + ;; user has been using until now + ;; The frame is made invisible initially, so that GtkPlug gets a + ;; chance to fully manage it. Then it works fine with Enlightenment + ;; as well + (let ((frame (make-frame '((visibility . nil))))) + (setq cmd (concat + cmd " --editor-window=" + (cdr (assoc 'outer-window-id (frame-parameters frame))))) + (select-frame frame))) + + ;; Add a -fullname switch + ;; Use the remote machine + (setq cmd (ada-remote (concat cmd " -fullname "))) + + ;; Ask for confirmation if required + (if (or arg ada-xref-confirm-compile) + (setq cmd (read-from-minibuffer "enter command to debug: " cmd))) + + (let ((old-comint-exec (symbol-function 'comint-exec))) + + ;; Do not add -fullname, since we can have a 'rsh' command in front. + ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef + (fset 'gud-gdb-massage-args (lambda (_file args) args)) + + (setq pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) + (if (not (equal pre-cmd "")) + (setq pre-cmd (concat pre-cmd ada-command-separator))) + + (setq post-cmd (mapconcat 'identity post-cmd "\n")) + (if post-cmd + (setq post-cmd (concat post-cmd "\n"))) + + + ;; Temporarily replaces the definition of `comint-exec' so that we + ;; can execute commands before running gdb. + ;; FIXME: This is evil and not temporary !!! -stef + (fset 'comint-exec + `(lambda (buffer name command startfile switches) + (let (compilation-buffer-name-function) + (save-excursion + (setq compilation-buffer-name-function + (lambda(x) (buffer-name buffer))) + (compile (ada-quote-cmd + (concat ,pre-cmd + command " " + (mapconcat 'identity switches " ")))))) + )) + + ;; Tight integration should force the tty mode + (if (and (string-match "gvd" (comint-arguments cmd 0 0)) + ada-tight-gvd-integration + (not (string-match "--tty" cmd))) + (setq cmd (concat cmd "--tty"))) + + (if (and (string-match "jdb" (comint-arguments cmd 0 0)) + (boundp 'jdb)) + (funcall (symbol-function 'jdb) cmd) + (gdb cmd)) + + ;; Restore the standard fset command (or for instance C-U M-x shell + ;; wouldn't work anymore + + (fset 'comint-exec old-comint-exec) + + ;; Send post-commands to the debugger + (process-send-string (get-buffer-process (current-buffer)) post-cmd) + + ;; Move to the end of the debugger buffer, so that it is automatically + ;; scrolled from then on. + (goto-char (point-max)) + + ;; Display both the source window and the debugger window (the former + ;; above the latter). No need to show the debugger window unless it + ;; is going to have some relevant information. + (if (or (not (string-match "gvd" (comint-arguments cmd 0 0))) + (string-match "--tty" cmd)) + (split-window-below)) + (switch-to-buffer buffer) + ))) + +(defun ada-reread-prj-file (&optional filename) + "Reread either the current project, or FILENAME if non-nil. +If FILENAME is non-nil, set it as current project." + (interactive "P") + (if (not filename) + (setq filename ada-prj-default-project-file)) + (ada-parse-prj-file filename) + (ada-select-prj-file filename)) + +;; ------ Private routines + +(defun ada-xref-current (file &optional ali-file-name) + "Update the cross-references for FILE. +This in fact recompiles FILE to create ALI-FILE-NAME. +This function returns the name of the file that was recompiled to generate +the cross-reference information. Note that the ali file can then be deduced +by replacing the file extension with `.ali'." + ;; kill old buffer + (if (and ali-file-name + (get-file-buffer ali-file-name)) + (kill-buffer (get-file-buffer ali-file-name))) + + (let* ((name (convert-standard-filename file)) + (body-name (or (ada-get-body-name name) name))) + + ;; Always recompile the body when we can. We thus temporarily switch to a + ;; buffer than contains the body of the unit + (save-excursion + (let ((body-visible (find-buffer-visiting body-name)) + process) + (if body-visible + (set-buffer body-visible) + (find-file body-name)) + + ;; Execute the compilation. Note that we must wait for the end of the + ;; process, or the ALI file would still not be available. + ;; Unfortunately, the underlying `compile' command that we use is + ;; asynchronous. + (ada-compile-current) + (setq process (get-buffer-process "*compilation*")) + + (while (and process + (not (equal (process-status process) 'exit))) + (sit-for 1)) + + ;; remove the buffer for the body if it wasn't there before + (unless body-visible + (kill-buffer (find-buffer-visiting body-name))) + )) + body-name)) + +(defun ada-find-file-in-dir (file dir-list) + "Search for FILE in DIR-LIST." + (let (found) + (while (and (not found) dir-list) + (setq found (concat (file-name-as-directory (car dir-list)) + (file-name-nondirectory file))) + + (unless (file-exists-p found) + (setq found nil)) + (setq dir-list (cdr dir-list))) + found)) + +(defun ada-find-ali-file-in-dir (file) + "Find the ali file FILE, searching obj_dir for the current project. +Adds build_dir in front of the search path to conform to gnatmake's behavior, +and the standard runtime location at the end." + (ada-find-file-in-dir file (ada-xref-get-obj-dir-field))) + +(defun ada-find-src-file-in-dir (file) + "Find the source file FILE, searching src_dir for the current project. +Adds the standard runtime location at the end of the search path to conform +to gnatmake's behavior." + (ada-find-file-in-dir file (ada-xref-get-src-dir-field))) + +(defun ada-get-ali-file-name (file) + "Create the ali file name for the Ada file FILE. +The file is searched for in every directory shown in the obj_dir lines of +the project file." + + ;; This function has to handle the special case of non-standard + ;; file names (i.e. not .adb or .ads) + ;; The trick is the following: + ;; 1- replace the extension of the current file with .ali, + ;; and look for this file + ;; 2- If this file is found: + ;; grep the "^U" lines, and make sure we are not reading the + ;; .ali file for a spec file. If we are, go to step 3. + ;; 3- If the file is not found or step 2 failed: + ;; find the name of the "other file", ie the body, and look + ;; for its associated .ali file by substituting the extension + ;; + ;; We must also handle the case of separate packages and subprograms: + ;; 4- If no ali file was found, we try to modify the file name by removing + ;; everything after the last '-' or '.' character, so as to get the + ;; ali file for the parent unit. If we found an ali file, we check that + ;; it indeed contains the definition for the separate entity by checking + ;; the 'D' lines. This is done repeatedly, in case the direct parent is + ;; also a separate. + + (with-current-buffer (get-file-buffer file) + (let ((short-ali-file-name (concat (file-name-base file) ".ali")) + ali-file-name + is-spec) + + ;; If we have a non-standard file name, and this is a spec, we first + ;; look for the .ali file of the body, since this is the one that + ;; contains the most complete information. If not found, we will do what + ;; we can with the .ali file for the spec... + + (if (not (string= (file-name-extension file) "ads")) + (let ((specs ada-spec-suffixes)) + (while specs + (if (string-match (concat (regexp-quote (car specs)) "$") + file) + (setq is-spec t)) + (setq specs (cdr specs))))) + + (if is-spec + (setq ali-file-name + (ada-find-ali-file-in-dir + (concat (file-name-base (ada-other-file-name)) ".ali")))) + + + (setq ali-file-name + (or ali-file-name + + ;; Else we take the .ali file associated with the unit + (ada-find-ali-file-in-dir short-ali-file-name) + + + ;; else we did not find the .ali file Second chance: in case + ;; the files do not have standard names (such as for instance + ;; file_s.ada and file_b.ada), try to go to the other file + ;; and look for its ali file + (ada-find-ali-file-in-dir + (concat (file-name-base (ada-other-file-name)) ".ali")) + + + ;; If we still don't have an ali file, try to get the one + ;; from the parent unit, in case we have a separate entity. + (let ((parent-name (file-name-base file))) + + (while (and (not ali-file-name) + (string-match "^\\(.*\\)[.-][^.-]*" parent-name)) + + (setq parent-name (match-string 1 parent-name)) + (setq ali-file-name (ada-find-ali-file-in-dir + (concat parent-name ".ali"))) + ) + ali-file-name))) + + ;; If still not found, try to recompile the file + (if (not ali-file-name) + ;; Recompile only if the user asked for this, and search the ali + ;; filename again. We avoid a possible infinite recursion by + ;; temporarily disabling the automatic compilation. + + (if ada-xref-create-ali + (setq ali-file-name + (concat (file-name-sans-extension (ada-xref-current file)) + ".ali")) + + (error "`.ali' file not found; recompile your source file")) + + + ;; same if the .ali file is too old and we must recompile it + (if (and (file-newer-than-file-p file ali-file-name) + ada-xref-create-ali) + (ada-xref-current file ali-file-name))) + + ;; Always return the correct absolute file name + (expand-file-name ali-file-name)) + )) + +(defun ada-get-ada-file-name (file original-file) + "Create the complete file name (+directory) for FILE. +The original file (where the user was) is ORIGINAL-FILE. +Search in project file for possible paths." + + (save-excursion + + ;; If the buffer for original-file, use it to get the values from the + ;; project file, otherwise load the file and its project file + (let ((buffer (get-file-buffer original-file))) + (if buffer + (set-buffer buffer) + (find-file original-file))) + + ;; we choose the first possible completion and we + ;; return the absolute file name + (let ((filename (ada-find-src-file-in-dir file))) + (if filename + (expand-file-name filename) + (signal 'ada-error-file-not-found (file-name-nondirectory file))) + ))) + +(defun ada-find-file-number-in-ali (file) + "Return the file number for FILE in the associated ali file." + (set-buffer (ada-get-ali-buffer file)) + (goto-char (point-min)) + + (let ((begin (re-search-forward "^D"))) + (beginning-of-line) + (re-search-forward (concat "^D " (file-name-nondirectory file))) + (count-lines begin (point)))) + +(defun ada-read-identifier (pos) + "Return the identlist around POS and switch to the .ali buffer. +The returned list represents the entity, and can be manipulated through the +macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." + + ;; If at end of buffer (e.g the buffer is empty), error + (if (>= (point) (point-max)) + (error "No identifier on point")) + + ;; goto first character of the identifier/operator (skip backward < and > + ;; since they are part of multiple character operators + (goto-char pos) + (skip-chars-backward "a-zA-Z0-9_<>") + + ;; check if it really is an identifier + (if (ada-in-comment-p) + (error "Inside comment")) + + (let (identifier identlist) + ;; Just in front of a string => we could have an operator declaration, + ;; as in "+", "-", .. + (if (= (char-after) ?\") + (forward-char 1)) + + ;; if looking at an operator + ;; This is only true if: + ;; - the symbol is +, -, ... + ;; - the symbol is made of letters, and not followed by _ or a letter + (if (and (looking-at ada-operator-re) + (or (not (= (char-syntax (char-after)) ?w)) + (not (or (= (char-syntax (char-after (match-end 0))) ?w) + (= (char-after (match-end 0)) ?_))))) + (progn + (if (and (= (char-before) ?\") + (= (char-after (+ (length (match-string 0)) (point))) ?\")) + (forward-char -1)) + (setq identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) + + (if (ada-in-string-p) + (error "Inside string or character constant")) + (if (looking-at (concat ada-keywords "[^a-zA-Z_]")) + (error "No cross-reference available for reserved keyword")) + (if (looking-at "[a-zA-Z0-9_]+") + (setq identifier (match-string 0)) + (error "No identifier around"))) + + ;; Build the identlist + (setq identlist (ada-make-identlist)) + (ada-set-name identlist (downcase identifier)) + (ada-set-line identlist + (number-to-string (count-lines 1 (point)))) + (ada-set-column identlist + (number-to-string (1+ (current-column)))) + (ada-set-file identlist (buffer-file-name)) + identlist + )) + +(defun ada-get-all-references (identlist) + "Complete IDENTLIST with definition file and places where it is referenced. +Information is extracted from the ali file." + + (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist))) + declaration-found) + (set-buffer ali-buffer) + (goto-char (point-min)) + (ada-set-on-declaration identlist nil) + + ;; First attempt: we might already be on the declaration of the identifier + ;; We want to look for the declaration only in a definite interval (after + ;; the "^X ..." line for the current file, and before the next "^X" line + + (if (re-search-forward + (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) + nil t) + (let ((bound (save-excursion (re-search-forward "^X " nil t)))) + (setq declaration-found + (re-search-forward + (concat "^" (ada-line-of identlist) + "." (ada-column-of identlist) + "[ *]" (ada-name-of identlist) + "[{[(<= ]?\\(.*\\)$") bound t)) + (if declaration-found + (ada-set-on-declaration identlist t)) + )) + + ;; If declaration is still nil, then we were not on a declaration, and + ;; have to fall back on other algorithms + + (unless declaration-found + + ;; Since we already know the number of the file, search for a direct + ;; reference to it + (goto-char (point-min)) + (setq declaration-found t) + (ada-set-ali-index + identlist + (number-to-string (ada-find-file-number-in-ali + (ada-file-of identlist)))) + (unless (re-search-forward (concat (ada-ali-index-of identlist) + "|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? \\)*" + (ada-line-of identlist) + "[^etpzkd<>=^]" + (ada-column-of identlist) "\\>") + nil t) + + ;; if we did not find it, it may be because the first reference + ;; is not required to have a 'unit_number|' item included. + ;; Or maybe we are already on the declaration... + (unless (re-search-forward + (concat + "^[0-9]+.[0-9]+[ *]" + (ada-name-of identlist) + "[ <{=([]\\(.\\|\n\\.\\)*\\<" + (ada-line-of identlist) + "[^0-9]" + (ada-column-of identlist) "\\>") + nil t) + + ;; If still not found, then either the declaration is unknown + ;; or the source file has been modified since the ali file was + ;; created + (setq declaration-found nil) + ) + ) + + ;; Last check to be completely sure we have found the correct line (the + ;; ali might not be up to date for instance) + (if declaration-found + (progn + (beginning-of-line) + ;; while we have a continuation line, go up one line + (while (looking-at "^\\.") + (forward-line -1) + (beginning-of-line)) + (unless (looking-at (concat "[0-9]+.[0-9]+[ *]" + (ada-name-of identlist) "[ <{=([]")) + (setq declaration-found nil)))) + + ;; Still no success ! The ali file must be too old, and we need to + ;; use a basic algorithm based on guesses. Note that this only happens + ;; if the user does not want us to automatically recompile files + ;; automatically + (unless declaration-found + (if (ada-xref-find-in-modified-ali identlist) + (setq declaration-found t) + ;; No more idea to find the declaration. Give up + (progn + (kill-buffer ali-buffer) + + (error "No declaration of %s found" (ada-name-of identlist)) + ))) + ) + + + ;; Now that we have found a suitable line in the .ali file, get the + ;; information available + (beginning-of-line) + (if declaration-found + (let ((current-line (buffer-substring + (point) (point-at-eol)))) + (save-excursion + (forward-line 1) + (beginning-of-line) + (while (looking-at "^\\.\\(.*\\)") + (setq current-line (concat current-line (match-string 1))) + (forward-line 1)) + ) + + (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t) + + ;; If we can find the file + (condition-case err + (ada-set-declare-file + identlist + (ada-get-ada-file-name (match-string 1) + (ada-file-of identlist))) + + ;; Else clean up the ali file + (ada-error-file-not-found + (signal (car err) (cdr err))) + (error + (kill-buffer ali-buffer) + (error (error-message-string err))) + )) + + (ada-set-references identlist current-line) + )) + )) + +(defun ada-xref-find-in-modified-ali (identlist) + "Find the matching position for IDENTLIST in the current ali buffer. +This function is only called when the file was not up-to-date, so we need +to make some guesses. +This function is disabled for operators, and only works for identifiers." + + (unless (= (string-to-char (ada-name-of identlist)) ?\") + (progn + (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... )) + (my-regexp (concat "[ *]" + (regexp-quote (ada-name-of identlist)) " ")) + (line-ada "--") + (col-ada "--") + (line-ali 0) + (len 0) + (choice 0) + (ali-buffer (current-buffer))) + + (goto-char (point-max)) + (while (re-search-backward my-regexp nil t) + (save-excursion + (setq line-ali (count-lines 1 (point))) + (beginning-of-line) + ;; have a look at the line and column numbers + (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") + (progn + (setq line-ada (match-string 1)) + (setq col-ada (match-string 2))) + (setq line-ada "--") + (setq col-ada "--") + ) + ;; construct a list with the file names and the positions within + (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t) + (cl-pushnew (list line-ali (match-string 1) line-ada col-ada) + declist :test #'equal) + ) + ) + ) + + ;; how many possible declarations have we found ? + (setq len (length declist)) + (cond + ;; none => error + ((= len 0) + (kill-buffer (current-buffer)) + (error "No declaration of %s recorded in .ali file" + (ada-name-of identlist))) + ;; one => should be the right one + ((= len 1) + (goto-char (point-min)) + (forward-line (1- (caar declist)))) + + ;; more than one => display choice list + (t + (save-window-excursion + (with-output-to-temp-buffer "*choice list*" + + (princ "Identifier is overloaded and Xref information is not up to date.\n") + (princ "Possible declarations are:\n\n") + (princ " no. in file at line col\n") + (princ " --- --------------------- ---- ----\n") + (let ((counter 0)) + (while (< counter len) + (princ (format " %2d) %-21s %4s %4s\n" + (1+ counter) + (ada-get-ada-file-name + (nth 1 (nth counter declist)) + (ada-file-of identlist)) + (nth 2 (nth counter declist)) + (nth 3 (nth counter declist)) + )) + (setq counter (1+ counter)) + ) ; end of while + ) ; end of let + ) ; end of with-output-to ... + (setq choice nil) + (while (or + (not choice) + (not (integerp choice)) + (< choice 1) + (> choice len)) + (setq choice + (string-to-number + (read-from-minibuffer "Enter No. of your choice: ")))) + ) + (set-buffer ali-buffer) + (goto-char (point-min)) + (forward-line (1- (car (nth (1- choice) declist)))) + )))))) + + +(defun ada-find-in-ali (identlist &optional other-frame) + "Look in the .ali file for the definition of the identifier in IDENTLIST. +If OTHER-FRAME is non-nil, and `ada-xref-other-buffer' is non-nil, +opens a new window to show the declaration." + + (ada-get-all-references identlist) + (let ((ali-line (ada-references-of identlist)) + (locations nil) + (start 0) + file line col) + + ;; Note: in some cases, an entity can have multiple references to the + ;; bodies (this is for instance the case for a separate subprogram, that + ;; has a reference both to the stub and to the real body). + ;; In that case, we simply go to each one in turn. + + ;; Get all the possible locations + (string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line) + (setq locations (list (list (match-string 1 ali-line) ;; line + (match-string 2 ali-line) ;; column + (ada-declare-file-of identlist)))) + (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)" + ali-line start) + (setq line (match-string 1 ali-line) + col (match-string 3 ali-line) + start (match-end 3)) + + ;; it there was a file number in the same line + ;; Make sure we correctly handle the case where the first file reference + ;; on the line is the type reference. + ;; 1U2 T(2|2r3) 34r23 + (if (string-match (concat "[^{(<0-9]\\([0-9]+\\)|\\([^|bc]+\\)?" + (match-string 0 ali-line)) + ali-line) + (let ((file-number (match-string 1 ali-line))) + (goto-char (point-min)) + (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t + (string-to-number file-number)) + (setq file (match-string 1)) + ) + ;; Else get the nearest file + (setq file (ada-declare-file-of identlist))) + + (setq locations (append locations (list (list line col file))))) + + ;; Add the specs at the end again, so that from the last body we go to + ;; the specs + (setq locations (append locations (list (car locations)))) + + ;; Find the new location we want to go to. + ;; If we are on none of the locations listed, we simply go to the specs. + + (setq line (caar locations) + col (nth 1 (car locations)) + file (nth 2 (car locations))) + + (while locations + (if (and (string= (caar locations) (ada-line-of identlist)) + (string= (nth 1 (car locations)) (ada-column-of identlist)) + (string= (file-name-nondirectory (nth 2 (car locations))) + (file-name-nondirectory (ada-file-of identlist)))) + (setq locations (cadr locations) + line (car locations) + col (nth 1 locations) + file (nth 2 locations) + locations nil) + (setq locations (cdr locations)))) + + ;; Find the file in the source path + (setq file (ada-get-ada-file-name file (ada-file-of identlist))) + + ;; Kill the .ali buffer + (kill-buffer (current-buffer)) + + ;; Now go to the buffer + (ada-xref-change-buffer file + (string-to-number line) + (1- (string-to-number col)) + identlist + other-frame) + )) + +(defun ada-find-in-src-path (identlist &optional other-frame) + "More general function for cross-references. +This function should be used when the standard algorithm that parses the +.ali file has failed, either because that file was too old or even did not +exist. +This function attempts to find the possible declarations for the identifier +anywhere in the object path. +This command requires the external `grep' program to be available. + +This works well when one is using an external library and wants to find +the declaration and documentation of the subprograms one is using." +;; FIXME: what does this function do? + (let (list + (dirs (ada-xref-get-obj-dir-field)) + (regexp (concat "[ *]" (ada-name-of identlist))) + line column + choice + file) + + ;; Do the grep in all the directories. We do multiple shell + ;; commands instead of one in case there is no .ali file in one + ;; of the directory and the shell stops because of that. + + (with-current-buffer (get-buffer-create "*grep*") + (while dirs + (insert (shell-command-to-string + (concat + "grep -E -i -h " + (shell-quote-argument (concat "^X|" regexp "( |$)")) + " " + (shell-quote-argument (file-name-as-directory (car dirs))) + "*.ali"))) + (setq dirs (cdr dirs))) + + ;; Now parse the output + (setq case-fold-search t) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (save-excursion + (beginning-of-line) + (if (not (= (char-after) ?X)) + (progn + (looking-at "\\([0-9]+\\).\\([0-9]+\\)") + (setq line (match-string 1) + column (match-string 2)) + (re-search-backward "^X [0-9]+ \\(.*\\)$") + (setq file (list (match-string 1) line column)) + + ;; There could be duplicate choices, because of the structure + ;; of the .ali files + (unless (member file list) + (setq list (append list (list file)))))))) + + ;; Current buffer is still "*grep*" + (kill-buffer "*grep*") + ) + + ;; Now display the list of possible matches + (cond + + ;; No choice found => Error + ((null list) + (error "No cross-reference found, please recompile your file")) + + ;; Only one choice => Do the cross-reference + ((= (length list) 1) + (setq file (ada-find-src-file-in-dir (caar list))) + (if file + (ada-xref-change-buffer file + (string-to-number (nth 1 (car list))) + (string-to-number (nth 2 (car list))) + identlist + other-frame) + (error "%s not found in src_dir" (caar list))) + (message "This is only a (good) guess at the cross-reference.") + ) + + ;; Else, ask the user + (t + (save-window-excursion + (with-output-to-temp-buffer "*choice list*" + + (princ "Identifier is overloaded and Xref information is not up to date.\n") + (princ "Possible declarations are:\n\n") + (princ " no. in file at line col\n") + (princ " --- --------------------- ---- ----\n") + (let ((counter 0)) + (while (< counter (length list)) + (princ (format " %2d) %-21s %4s %4s\n" + (1+ counter) + (nth 0 (nth counter list)) + (nth 1 (nth counter list)) + (nth 2 (nth counter list)) + )) + (setq counter (1+ counter)) + ))) + (setq choice nil) + (while (or (not choice) + (not (integerp choice)) + (< choice 1) + (> choice (length list))) + (setq choice + (string-to-number + (read-from-minibuffer "Enter No. of your choice: ")))) + ) + (setq choice (1- choice)) + (kill-buffer "*choice list*") + + (setq file (ada-find-src-file-in-dir (car (nth choice list)))) + (if file + (ada-xref-change-buffer file + (string-to-number (nth 1 (nth choice list))) + (string-to-number (nth 2 (nth choice list))) + identlist + other-frame) + (signal 'ada-error-file-not-found (car (nth choice list)))) + (message "This is only a (good) guess at the cross-reference.") + )))) + +(defun ada-xref-change-buffer + (file line column identlist &optional other-frame) + "Select and display FILE, at LINE and COLUMN. +If we do not end on the same identifier as IDENTLIST, find the +closest match. Kills the .ali buffer at the end. +If OTHER-FRAME is non-nil, creates a new frame to show the file." + + (let (declaration-buffer) + + ;; Select and display the destination buffer + (if ada-xref-other-buffer + (if other-frame + (find-file-other-frame file) + (setq declaration-buffer (find-file-noselect file)) + (set-buffer declaration-buffer) + (switch-to-buffer-other-window declaration-buffer) + ) + (find-file file) + ) + + ;; move the cursor to the correct position + (push-mark) + (goto-char (point-min)) + (forward-line (1- line)) + (move-to-column column) + + ;; If we are not on the identifier, the ali file was not up-to-date. + ;; Try to find the nearest position where the identifier is found, + ;; this is probably the right one. + (unless (looking-at (ada-name-of identlist)) + (ada-xref-search-nearest (ada-name-of identlist))) + )) + + +(defun ada-xref-search-nearest (name) + "Search for NAME nearest to the position recorded in the Xref file. +Return the position of the declaration in the buffer, or nil if not found." + (let ((orgpos (point)) + (newpos nil) + (diff nil)) + + (goto-char (point-max)) + + ;; loop - look for all declarations of name in this file + (while (search-backward name nil t) + + ;; check if it really is a complete Ada identifier + (if (and + (not (save-excursion + (goto-char (match-end 0)) + (looking-at "_"))) + (not (ada-in-string-or-comment-p)) + (or + ;; variable declaration ? + (save-excursion + (skip-chars-forward "a-zA-Z_0-9" ) + (ada-goto-next-non-ws) + (looking-at ":[^=]")) + ;; procedure, function, task or package declaration ? + (save-excursion + (ada-goto-previous-word) + (looking-at "\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>")))) + + ;; check if it is nearer than the ones before if any + (if (or (not diff) + (< (abs (- (point) orgpos)) diff)) + (progn + (setq newpos (point) + diff (abs (- newpos orgpos)))))) + ) + + (if newpos + (progn + (message "ATTENTION: this declaration is only a (good) guess ...") + (goto-char newpos)) + nil))) + + +;; Find the parent library file of the current file +(defun ada-goto-parent () + "Go to the parent library file." + (interactive) + (ada-require-project-file) + + (let ((buffer (ada-get-ali-buffer (buffer-file-name))) + (unit-name nil) + (body-name nil) + (ali-name nil)) + (with-current-buffer buffer + (goto-char (point-min)) + (re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)") + (setq unit-name (match-string 1)) + (if (not (string-match "\\(.*\\)\\.[^.]+" unit-name)) + (progn + (kill-buffer buffer) + (error "No parent unit !")) + (setq unit-name (match-string 1 unit-name)) + ) + + ;; look for the file name for the parent unit specification + (goto-char (point-min)) + (re-search-forward (concat "^W " unit-name + "%s[ \t]+\\([^ \t]+\\)[ \t]+" + "\\([^ \t\n]+\\)")) + (setq body-name (match-string 1)) + (setq ali-name (match-string 2)) + (kill-buffer buffer) + ) + + (setq ali-name (ada-find-ali-file-in-dir ali-name)) + + (save-excursion + ;; Tries to open the new ali file to find the spec file + (if ali-name + (progn + (find-file ali-name) + (goto-char (point-min)) + (re-search-forward (concat "^U " unit-name "%s[ \t]+" + "\\([^ \t]+\\)")) + (setq body-name (match-string 1)) + (kill-buffer (current-buffer)) + ) + ) + ) + + (find-file body-name) + )) + +(defun ada-make-filename-from-adaname (adaname) + "Determine the filename in which ADANAME is found. +This is a GNAT specific function that uses gnatkrunch." + (let ((krunch-buf (generate-new-buffer "*gkrunch*")) + (cross-prefix (plist-get (cdr (ada-xref-current-project)) 'cross_prefix))) + (with-current-buffer krunch-buf + ;; send adaname to external process `gnatkr'. + ;; Add a dummy extension, since gnatkr versions have two different + ;; behaviors depending on the version: + ;; Up to 3.15: "AA.BB.CC" => aa-bb-cc + ;; After: "AA.BB.CC" => aa-bb.cc + (call-process (concat cross-prefix "gnatkr") nil krunch-buf nil + (concat adaname ".adb") ada-krunch-args) + ;; fetch output of that process + (setq adaname (buffer-substring + (point-min) + (progn + (goto-char (point-min)) + (end-of-line) + (point)))) + ;; Remove the extra extension we added above + (setq adaname (substring adaname 0 -4)) + + (kill-buffer krunch-buf))) + adaname + ) + +(defun ada-make-body-gnatstub (&optional interactive) + "Create an Ada package body in the current buffer. +This function uses the `gnat stub' program to create the body. +This function typically is to be hooked into `ff-file-created-hook'. +If INTERACTIVE is nil, assume this is called from `ff-file-created-hook'." + (interactive "p") + (ada-require-project-file) + + ;; If not interactive, assume we are being called from + ;; ff-file-created-hook. Then the current buffer is for the body + ;; file, but we will create a new one after gnat stub runs + (unless interactive + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) + + (save-some-buffers nil nil) + + ;; Make sure the current buffer is the spec, so gnat stub gets the + ;; right package parameter (this might not be the case if for + ;; instance the user was asked for a project file) + + (unless (buffer-file-name (car (buffer-list))) + (set-buffer (cadr (buffer-list)))) + + ;; Call the external process + (let* ((project-plist (cdr (ada-xref-current-project))) + (gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts)) + (gpr-file (plist-get project-plist 'gpr_file)) + (filename (buffer-file-name (car (buffer-list)))) + (output (concat (file-name-sans-extension filename) ".adb")) + (cross-prefix (plist-get project-plist 'cross_prefix)) + (gnatstub-cmd (concat cross-prefix "gnat stub" + (if (not (string= gpr-file "")) + (concat " -P\"" gpr-file "\"")) + " " gnatstub-opts " " filename)) + (buffer (get-buffer-create "*gnat stub*"))) + + (with-current-buffer buffer + (compilation-minor-mode 1) + (erase-buffer) + (insert gnatstub-cmd) + (newline) + ) + + (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd) + + ;; clean up the output + + (if (file-exists-p output) + (progn + (find-file output) + (kill-buffer buffer)) + + ;; file not created; display the error message + (display-buffer buffer)))) + +(defun ada-xref-initialize () + "Function called by `ada-mode-hook' to initialize the ada-xref.el package. +For instance, it creates the gnat-specific menus, sets some hooks for +`find-file'." + (remove-hook 'ff-file-created-hook 'ada-make-body) ; from global hook + (remove-hook 'ff-file-created-hook 'ada-make-body t) ; from local hook + (add-hook 'ff-file-created-hook 'ada-make-body-gnatstub nil t) + + ;; Completion for file names in the mini buffer should ignore .ali files + (add-to-list 'completion-ignored-extensions ".ali") + + (ada-xref-update-project-menu) + ) + +;; ----- Add to ada-mode-hook --------------------------------------------- + +;; This must be done before initializing the Ada menu. +(add-hook 'ada-mode-hook 'ada-xref-initialize) + +;; Define a new error type +(define-error 'ada-error-file-not-found + "File not found in src-dir (check project file): " 'ada-mode-errors) + +(provide 'ada-xref) + +;;; ada-xref.el ends here diff --git a/old-ada/doc/ada-mode.html b/old-ada/doc/ada-mode.html new file mode 100644 index 0000000..6788acb --- /dev/null +++ b/old-ada/doc/ada-mode.html @@ -0,0 +1,2288 @@ + + + + + + +Ada Mode + + + + + + + + + + + + + + + + + + +

Ada Mode

+ + + + + +
+
+

+Next:   [Contents][Index]

+
+

Ada Mode

+ +

Copyright © 1999–2019 Free Software Foundation, Inc. +

+
+

Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover Texts being “A GNU Manual”, +and with the Back-Cover Texts as in (a) below. A copy of the license +is included in the section entitled “GNU Free Documentation License”. +

+

(a) The FSF’s Back-Cover Text is: “You have the freedom to copy and +modify this GNU manual.” +

+ + + + +
+
+
+

+Next: , Previous: , Up: Ada Mode   [Contents][Index]

+
+

1 Overview

+ +

The Emacs mode for programming in Ada helps the user in understanding +existing code and facilitates writing new code. +

+

When the GNU Ada compiler GNAT is used, the cross-reference +information output by the compiler is used to provide powerful code +navigation (jump to definition, find all uses, etc.). +

+

When you open a file with a file extension of .ads or +.adb, Emacs will automatically load and activate Ada mode. +

+

Ada mode works without any customization, if you are using the GNAT +compiler (https://libre2.adacore.com/) and the GNAT default +naming convention. +

+

You must customize a few things if you are using a different compiler +or file naming convention; See Other compiler, See Non-standard file names. +

+

In addition, you may want to customize the indentation, +capitalization, and other things; See Other customization. +

+

Finally, for large Ada projects, you will want to set up an Emacs +Ada mode project file for each project; See Project files. Note +that these are different from the GNAT project files used by gnatmake +and other GNAT commands. +

+

See the Emacs info manual, section ’Running Debuggers Under Emacs’, +for general information on debugging. +

+
+
+
+
+

+Next: , Previous: , Up: Ada Mode   [Contents][Index]

+
+

2 Installation

+ +

Ada mode is part of the standard Emacs distribution; if you use that, +no files need to be installed. +

+

Ada mode is also available as a separate distribution, from the Emacs +Ada mode website +http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html. The +separate distribution may be more recent. +

+

For installing the separate distribution, see the README file +in the distribution. +

+

To see what version of Ada mode you have installed, do M-x +ada-mode-version. +

+

The following files are provided with the Ada mode distribution: +

+
    +
  • ada-mode.el: The main file for Ada mode, providing indentation, +formatting of parameter lists, moving through code, comment handling +and automatic casing. + +
  • ada-prj.el: GUI editing of Ada mode project files, using Emacs +widgets. + +
  • ada-stmt.el: Ada statement templates. + +
  • ada-xref.el: GNAT cross-references, completion of identifiers, +and compilation. Also provides project files (which are not +GNAT-specific). + +
+ +
+
+
+
+

+Next: , Previous: , Up: Ada Mode   [Contents][Index]

+
+

3 Customizing Ada mode

+ +

Here we assume you are familiar with setting variables in Emacs, +either thru ’customize’ or in elisp (in your .emacs file). For +a basic introduction to customize, elisp, and Emacs in general, see +the tutorial in +The GNU Emacs Manual. +

+

These global Emacs settings are strongly recommended (put them in your +.emacs): +

+
+
(global-font-lock-mode t)
+(transient-mark-mode t)
+
+ +

(global-font-lock-mode t)’ turns on syntax +highlighting for all buffers (it is off by default because it may be +too slow for some machines). +

+

(transient-mark-mode t)’ highlights selected text. +

+

See the Emacs help for each of these variables for more information. +

+ + +
+
+ +

3.1 Non-standard file names

+ +

By default, Ada mode is configured to use the GNAT file naming +convention, where file names are a simple modification of the Ada +names, and the extension for specs and bodies are +‘.ads’ and ‘.adb’, respectively. +

+

Ada mode uses the file extensions to allow moving from a package body +to the corresponding spec and back. +

+

Ada mode supports a list of alternative file extensions for specs and bodies. +

+

For instance, if your spec and bodies files are called +unit_s.ada and unit_b.ada, respectively, you +can add the following to your .emacs file: +

+
+
(ada-add-extensions "_s.ada" "_b.ada")
+
+ +

You can define additional extensions: +

+
+
(ada-add-extensions ".ads" "_b.ada")
+(ada-add-extensions ".ads" ".body")
+
+ +

This means that whenever Ada mode looks for the body for a file +whose extension is .ads, it will take the first available file +that ends with either .adb, _b.ada or +.body. +

+

Similarly, if Ada mode is looking for a spec, it will look for +.ads or _s.ada. +

+

If the filename is not derived from the Ada name following the GNAT +convention, things are a little more complicated. You then need to +rewrite the function ada-make-filename-from-adaname. Doing that +is beyond the scope of this manual; see the current definitions in +ada-mode.el and ada-xref.el for examples. +

+
+
+
+ +

3.2 Other compiler

+ +

By default, Ada mode is configured to use the GNU Ada compiler GNAT. +

+

To use a different Ada compiler, you must specify the command lines +used to run that compiler, either in lisp variables or in Emacs +Ada mode project files. See Project file variables for the list +of project variables, and the corresponding lisp variables. +

+
+
+
+ +

3.3 Other customization

+ +

All user-settable Ada mode variables can be set via the menu +‘Ada | Customize’. Click on the ‘Help’ button there for help +on using customize. +

+

To modify a specific variable, you can directly call the function +customize-variable; just type M-x customize-variable +RET variable-name RET). +

+

Alternately, you can specify variable settings in the Emacs +configuration file, .emacs. This file is coded in Emacs lisp, +and the syntax to set a variable is the following: +

+
(setq variable-name value)
+
+ +
+
+
+
+
+

+Next: , Previous: , Up: Ada Mode   [Contents][Index]

+
+

4 Compiling Executing

+ +

Ada projects can be compiled, linked, and executed using commands on +the Ada menu. All of these commands can be customized via a project +file (see Project files), but the defaults are sufficient for using +the GNAT compiler for simple projects (single files, or several files +in a single directory). +

+

Even when no project file is used, the GUI project editor (menu +‘Ada | Project | Edit’) shows the settings of the various project +file variables referenced here. +

+ + +
+
+ +

4.1 Compile commands

+ +

Here are the commands for building and using an Ada project, as +listed in the Ada menu. +

+

In multi-file projects, there must be one file that is the main +program. That is given by the main project file variable; +it defaults to the current file if not yet set, but is also set by the +“set main and build” command. +

+
+
Check file
+

Compiles the current file in syntax check mode, by running +check_cmd defined in the current project file. This typically +runs faster than full compile mode, speeding up finding and fixing +compilation errors. +

+

This sets main only if it has not been set yet. +

+
+
Compile file
+

Compiles the current file, by running comp_cmd from the current +project file. +

+

This does not set main. +

+
+
Set main and Build
+

Sets main to the current file, then executes the Build +command. +

+
+
Show main
+

Display main in the message buffer. +

+
+
Build
+

Compiles all obsolete units of the current main, and links +main, by running make_cmd from the current project. +

+

This sets main only if it has not been set yet. +

+
+
Run
+

Executes the main program in a shell, displayed in a separate Emacs +buffer. This runs run_cmd from the current project. The +execution buffer allows for interactive input/output. +

+

To modify the run command, in particular to provide or change the +command line arguments, type C-u before invoking the command. +

+

This command is not available for a cross-compilation toolchain. +

+
+
+

It is important when using these commands to understand how +main is used and changed. +

+

Build runs ’gnatmake’ on the main unit. During a typical edit/compile +session, this is the only command you need to invoke, which is why it +is bound to C-c C-c. It will compile all files needed by the +main unit, and display compilation errors in any of them. +

+

Note that Build can be invoked from any Ada buffer; typically you will +be fixing errors in files other than the main, but you don’t have to +switch back to the main to invoke the compiler again. +

+

Novices and students typically work on single-file Ada projects. In +this case, C-c C-m will normally be the only command needed; it +will build the current file, rather than the last-built main. +

+

There are three ways to change main: +

+
    +
  1. Invoke ‘Ada | Set main and Build’, which sets main to +the current file. + +
  2. Invoke ‘Ada | Project | Edit’, edit main and +main, and click ‘[save]’ + +
  3. Invoke ‘Ada | Project | Load’, and load a project file that specifies main + +
+ +
+
+
+ +

4.2 Compiler errors

+ +

The Check file, Compile file, and Build commands +all place compilation errors in a separate buffer named +*compilation*. +

+

Each line in this buffer will become active: you can simply click on +it with the middle button of the mouse, or move point to it and press +RET. Emacs will then display the relevant source file and put +point on the line and column where the error was found. +

+

You can also press the C-x ` key (next-error), and Emacs +will jump to the first error. If you press that key again, it will +move you to the second error, and so on. +

+

Some error messages might also include references to other files. These +references are also clickable in the same way, or put point after the +line number and press RET. +

+
+
+
+
+ +

5 Project files

+ +

An Emacs Ada mode project file specifies what directories hold sources +for your project, and allows you to customize the compilation commands +and other things on a per-project basis. +

+

Note that Ada mode project files *.adp are different than GNAT +compiler project files *.gpr. However, Emacs Ada mode can use a +GNAT project file to specify the project directories. If no +other customization is needed, a GNAT project file can be used without +an Emacs Ada mode project file. +

+ + +
+
+
+

+Next: , Up: Project files   [Contents][Index]

+
+

5.1 Project File Overview

+ +

Project files have a simple syntax; they may be edited directly. Each +line specifies a project variable name and its value, separated by “=”: +

+
src_dir=/Projects/my_project/src_1
+src_dir=/Projects/my_project/src_2
+
+ +

Some variables (like src_dir) are lists; multiple occurrences +are concatenated. +

+

There must be no space between the variable name and “=”, and no +trailing spaces. +

+

Alternately, a GUI editor for project files is available (see GUI Editor). It uses Emacs widgets, similar to Emacs customize. +

+

The GUI editor also provides a convenient way to view current project +settings, if they have been modified using menu commands rather than +by editing the project file. +

+

After the first Ada mode build command is invoked, there is always a +current project file, given by the lisp variable +ada-prj-default-project-file. Currently, the only way to show +the current project file is to invoke the GUI editor. +

+

To find the project file the first time, Ada mode uses the following +search algorithm: +

+
    +
  • If ada-prj-default-project-file is set, use that. + +
  • Otherwise, search for a file in the current directory with +the same base name as the Ada file, but extension given by +ada-prj-file-extension (default ".adp"). + +
  • If not found, search for *.adp in the current directory; if +several are found, prompt the user to select one. + +
  • If none are found, use default.adp in the current directory (even +if it does not exist). + +
+ +

This algorithm always sets ada-prj-default-project-file, even +when the file does not actually exist. +

+

To change the project file before or after the first one is found, +invoke ‘Ada | Project | Load ...’. +

+

Or, in lisp, evaluate (ada-set-default-project-file "/path/file.adp"). +This sets ada-prj-default-project-file, and reads the project file. +

+

You can also specify a GNAT project file to ‘Ada | Project | Load +...’ or ada-set-default-project-file. Emacs Ada mode checks the +file extension; if it is .gpr, the file is treated as a GNAT +project file. Any other extension is treated as an Emacs Ada mode +project file. +

+
+
+
+ +

5.2 GUI Editor

+ +

The project file editor is invoked with the menu ‘Ada | Projects +| Edit’. +

+

Once in the buffer for editing the project file, you can save your +modification using the ‘[save]’ button at the bottom of the +buffer, or the C-x C-s binding. To cancel your modifications, +kill the buffer or click on the ‘[cancel]’ button. +

+
+
+
+
+

+Previous: , Up: Project files   [Contents][Index]

+
+

5.3 Project file variables

+ +

The following variables can be defined in a project file; some can +also be defined in lisp variables. +

+

To set a project variable that is a list, specify each element of the +list on a separate line in the project file. +

+

Any project variable can be referenced in other project variables, +using a shell-like notation. For instance, if the variable +comp_cmd contains ${comp_opt}, the value of the +comp_opt variable will be substituted when comp_cmd is +used. +

+

In addition, process environment variables can be referenced using the +same syntax, or the normal $var syntax. +

+

Most project variables have defaults that can be changed by setting +lisp variables; the table below identifies the lisp variable for each +project variable. Lisp variables corresponding to project variables +that are lists are lisp lists. +

+

In general, project variables are evaluated when referenced in +Emacs Ada mode commands. Relative file paths are expanded to +absolute relative to ${build_dir}. +

+

Here is the list of variables. In the default values, the current +directory "." is the project file directory. +

+
+
ada_project_path_sep [default: ":" or ";"]
+

Path separator for ADA_PROJECT_PATH. It defaults to the correct +value for a native implementation of GNAT for the current operating +system. The user must override this when using Windows native GNAT +with Cygwin Emacs, and perhaps in other cases. +

+

Lisp variable: ada-prj-ada-project-path-sep. +

+
+
ada_project_path [default: ""]
+

A list of directories to search for GNAT project files. +

+

If set, the ADA_PROJECT_PATH process environment variable is +set to this value in the Emacs process when the Emacs Ada mode project +is selected via menu ‘Ada | Project | Load’. +

+

For ada_project_path, relative file paths are expanded to +absolute when the Emacs Ada project file is read, rather than when the +project file is selected. +

+

For example if the project file is in the directory +/home/myproject, the environment variable GDS_ROOT is +set to /home/shared, and the project file contains: +

+
ada_project_path_sep=:
+ada_project_path=$GDS_ROOT/makerules
+ada_project_path=../opentoken
+
+

then as a result the environment variable ADA_PROJECT_PATH will +be set to "/home/shared/makerules:/home/opentoken/". +

+

The default value is not the current value of this environment +variable, because that will typically have been set by another +project, and will therefore be incorrect for this project. +

+

If you have the environment variable set correctly for all of your +projects, you do not need to set this project variable. +

+
+
bind_opt [default: ""]
+

Holds user binder options; used in the default build commands. +

+

Lisp variable: ada-prj-default-bind-opt. +

+
+
build_dir [default: "."]
+

The compile commands will be issued in this directory. +

+
+
casing [default: ("~/.emacs_case_exceptions")]
+

List of files containing casing exceptions. See the help on +ada-case-exception-file for more info. +

+

Lisp variable: ada-case-exception-file. +

+
+
check_cmd [default: "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current} -cargs ${comp_opt}"]
+

Command used to syntax check a single file. +The name of the file is substituted for full_current. +

+

Lisp variable: ada-prj-default-check-cmd +

+
+
comp_cmd [default: "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs ${comp_opt}"]
+

Command used to compile a single file. +The name of the file is substituted for full_current. +

+

Lisp variable: ada-prj-default-comp-cmd. +

+
+
comp_opt [default: "-gnatq -gnatQ"]
+

Holds user compiler options; used in the default compile commands. The +default value tells gnatmake to generate library files for +cross-referencing even when there are errors. +

+

If source code for the project is in multiple directories, the +appropriate compiler options must be added here. Set source search path for examples of this. Alternately, GNAT project files may +be used; Use GNAT project file. +

+

Lisp variable: ada-prj-default-comp-opt. +

+
+
cross_prefix [default: ""]
+

Name of target machine in a cross-compilation environment. Used in +default compile and build commands. +

+
+
debug_cmd [default: "${cross_prefix}gdb ${main}"]
+

Command used to debug the application +

+

Lisp variable: ada-prj-default-debugger. +

+
+
debug_post_cmd [default: ""]
+

Command executed after debug_cmd. +

+
+
debug_pre_cmd [default: "cd ${build_dir}"]
+

Command executed before debug_cmd. +

+
+
gnatfind_opt [default: "-rf"]
+

Holds user gnatfind options; used in the default find commands. +

+

Lisp variable: ada-prj-gnatfind-switches. +

+
+
gnatmake_opt [default: "-g"]
+

Holds user gnatmake options; used in the default build commands. +

+

Lisp variable: ada-prj-default-gnatmake-opt. +

+
+
gpr_file [default: ""]
+

Specify GNAT project file. +

+

If set, the source and object directories specified in the GNAT +project file are appended to src_dir and obj_dir. This +allows specifying Ada source directories with a GNAT project file, and +other source directories with the Emacs project file. +

+

In addition, -P{gpr_file} is added to the project variable +gnatmake_opt whenever it is referenced. With the default +project variables, this passes the project file to all gnatmake +commands. +

+

Lisp variable: ada-prj-default-gpr-file. +

+ +
+
link_opt [default: ""]
+

Holds user linker options; used in the default build commands. +

+

Lisp variable: ada-prj-default-link-opt. +

+
+
main [default: current file]
+

Specifies the name of the executable file for the project; used in the +default build commands. +

+
+
make_cmd [default: "${cross_prefix}gnatmake -o ${main} ${main} ${gnatmake_opt} -cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}"]
+

Command used to build the application. +

+

Lisp variable: ada-prj-default-make-cmd. +

+
+
obj_dir [default: "."]
+

A list of directories to search for library files. Ada mode searches +this list for the ‘.ali’ files generated by GNAT that contain +cross-reference information. +

+

The compiler commands must place the ‘.ali’ files in one of these +directories; the default commands do that. +

+
+
remote_machine [default: ""]
+

Name of the machine to log into before issuing the compile and build +commands. If this variable is empty, the command will be run on the +local machine. +

+
+
run_cmd [default: "./${main}"]
+

Command used to run the application. +

+
+
src_dir [default: "."]
+

A list of directories to search for source files, both for compile +commands and source navigation. +

+
+
+ +
+
+
+
+
+

+Next: , Previous: , Up: Ada Mode   [Contents][Index]

+
+

6 Compiling Examples

+ +

We present several small projects, and walk thru the process of +compiling, linking, and running them. +

+

The first example illustrates more Ada mode features than the others; +you should work thru that example before doing the others. +

+

All of these examples assume you are using GNAT. +

+

The source for these examples is available on the Emacs Ada mode +website mentioned in See Installation. +

+ + +
+
+ +

6.1 No project files

+

This example uses no project files. +

+

First, create a directory Example_1, containing: +

+

hello.adb: +

+
+
with Ada.Text_IO;
+procedure Hello
+is begin
+   Put_Line("Hello from hello.adb");
+end Hello;
+
+ +

Yes, this is missing “use Ada.Text_IO;” - we want to demonstrate +compiler error handling. +

+

hello_2.adb: +

+
+
with Hello_Pkg;
+procedure Hello_2
+is begin
+   Hello_Pkg.Say_Hello;
+end Hello_2;
+
+ +

This file has no errors. +

+

hello_pkg.ads: +

+
+
package Hello_Pkg is
+   procedure Say_Hello;
+end Hello_Pkg;
+
+ +

This file has no errors. +

+

hello_pkg.adb: +

+
+
with Ada.Text_IO;
+package Hello_Pkg is
+   procedure Say_Hello
+   is begin
+      Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb");
+   end Say_Hello;
+end Hello_Pkg;
+
+ +

Yes, this is missing the keyword body; another compiler error +example. +

+

In buffer hello.adb, invoke ‘Ada | Check file’. You should +get a *compilation* buffer containing something like (the +directory paths will be different): +

+
+
cd c:/Examples/Example_1/
+gnatmake -u -c -gnatc -g c:/Examples/Example_1/hello.adb -cargs -gnatq -gnatQ
+gcc -c -Ic:/Examples/Example_1/ -gnatc -g -gnatq -gnatQ -I- c:/Examples/Example_1/hello.adb
+hello.adb:4:04: "Put_Line" is not visible
+hello.adb:4:04: non-visible declaration at a-textio.ads:264
+hello.adb:4:04: non-visible declaration at a-textio.ads:260
+gnatmake: "c:/Examples/Example_1/hello.adb" compilation error
+
+ +

If you have enabled font-lock, the lines with actual errors (starting +with hello.adb) are highlighted, with the file name in red. +

+

Now type C-x ` (on a PC keyboard, ` is next to 1). +Or you can click the middle mouse button on the first error line. The +compilation buffer scrolls to put the first error on the top line, and +point is put at the place of the error in the hello.adb buffer. +

+

To fix the error, change the line to be +

+
+
    Ada.Text_IO.Put_Line ("hello from hello.adb");
+
+ +

Now invoke ‘Ada | Show main’; this displays ‘Ada mode main: hello’. +

+

Now (in buffer hello.adb), invoke ‘Ada | Build’. You are +prompted to save the file (if you haven’t already). Then the +compilation buffer is displayed again, containing: +

+
+
cd c:/Examples/Example_1/
+gnatmake -o hello hello -g -cargs -gnatq -gnatQ -bargs  -largs
+gcc -c -g -gnatq -gnatQ hello.adb
+gnatbind -x hello.ali
+gnatlink hello.ali -o hello.exe -g
+
+ +

The compilation has succeeded without errors; hello.exe now +exists in the same directory as hello.adb. +

+

Now invoke ‘Ada | Run’. A *run* buffer is displayed, +containing +

+
+
Hello from hello.adb
+
+Process run finished
+
+ +

That completes the first part of this example. +

+

Now we will compile a multi-file project. Open the file +hello_2.adb, and invoke ‘Ada | Set main and Build’. This +finds an error in hello_pkg.adb: +

+
+
cd c:/Examples/Example_1/
+gnatmake -o hello_2 hello_2 -g -cargs -gnatq -gnatQ -bargs  -largs
+gcc -c -g -gnatq -gnatQ hello_pkg.adb
+hello_pkg.adb:2:08: keyword "body" expected here [see file name]
+gnatmake: "hello_pkg.adb" compilation error
+
+ +

This demonstrates that gnatmake finds the files needed by the main +program. However, it cannot find files in a different directory, +unless you use an Emacs Ada mode project file to specify the other directories; +See Set source search path, or a GNAT project file; Use GNAT project file. +

+

Invoke ‘Ada | Show main’; this displays Ada mode main: hello_2. +

+

Move to the error with C-x `, and fix the error by adding body: +

+
+
package body Hello_Pkg is
+
+ +

Now, while still in hello_pkg.adb, invoke ‘Ada | Build’. +gnatmake successfully builds hello_2. This demonstrates that +Emacs has remembered the main file, in the project variable +main, and used it for the Build command. +

+

Finally, again while in hello_pkg.adb, invoke ‘Ada | Run’. +The *run* buffer displays Hello from hello_pkg.adb. +

+

One final point. If you switch back to buffer hello.adb, and +invoke ‘Ada | Run’, hello_2.exe will be run. That is +because main is still set to hello_2, as you can +see when you invoke ‘Ada | Project | Edit’. +

+

There are three ways to change main: +

+
    +
  1. Invoke ‘Ada | Set main and Build’, which sets main to +the current file. + +
  2. Invoke ‘Ada | Project | Edit’, edit main, and click ‘[save]’ + +
  3. Invoke ‘Ada | Project | Load’, and load a project file that specifies main + +
+ +
+
+
+ +

6.2 Set compiler options

+ +

This example illustrates using an Emacs Ada mode project file to set a +compiler option. +

+

If you have files from Example_1 open in Emacs, you should +close them so you don’t get confused. Use menu ‘File | Close +(current buffer)’. +

+

In directory Example_2, create these files: +

+

hello.adb: +

+
+
with Ada.Text_IO;
+procedure Hello
+is begin
+   Put_Line("Hello from hello.adb");
+end Hello;
+
+ +

This is the same as hello.adb from Example_1. It has two +errors; missing “use Ada.Text_IO;”, and no space between +Put_Line and its argument list. +

+

hello.adp: +

+
+
comp_opt=-gnatyt
+
+ +

This tells the GNAT compiler to check for token spacing; in +particular, there must be a space preceding a parenthesis. +

+

In buffer hello.adb, invoke ‘Ada | Project | Load...’, and +select Example_2/hello.adp. +

+

Then, again in buffer hello.adb, invoke ‘Ada | Set main and +Build’. You should get a *compilation* buffer containing +something like (the directory paths will be different): +

+
+
cd c:/Examples/Example_2/
+gnatmake -o hello hello -g -cargs -gnatyt  -bargs  -largs
+gcc -c -g -gnatyt hello.adb
+hello.adb:4:04: "Put_Line" is not visible
+hello.adb:4:04: non-visible declaration at a-textio.ads:264
+hello.adb:4:04: non-visible declaration at a-textio.ads:260
+hello.adb:4:12: (style) space required
+gnatmake: "hello.adb" compilation error
+
+ +

Compare this to the compiler output in No project files; the +gnatmake option -cargs -gnatq -gnatQ has been replaced by +-cargs -gnaty, and an additional error is reported in +hello.adb on line 4. This shows that hello.adp is being +used to set the compiler options. +

+

Fixing the error, linking and running the code proceed as in No project files. +

+
+
+
+ +

6.3 Set source search path

+ +

In this example, we show how to deal with files in more than one +directory. We start with the same code as in No project files; +create those files (with the errors present) +

+

Create the directory Example_3, containing: +

+

hello_pkg.ads: +

+
+
package Hello_Pkg is
+   procedure Say_Hello;
+end Hello_Pkg;
+
+ +

hello_pkg.adb: +

+
+
with Ada.Text_IO;
+package Hello_Pkg is
+   procedure Say_Hello
+   is begin
+      Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb");
+   end Say_Hello;
+end Hello_Pkg;
+
+ +

These are the same files from example 1; hello_pkg.adb has an +error on line 2. +

+

In addition, create a directory Example_3/Other, containing these files: +

+

Other/hello_3.adb: +

+
+
with Hello_Pkg;
+with Ada.Text_IO; use Ada.Text_IO;
+procedure Hello_3
+is begin
+   Hello_Pkg.Say_Hello;
+   Put_Line ("From hello_3");
+end Hello_3;
+
+ +

There are no errors in this file. +

+

Other/other.adp: +

+
+
src_dir=..
+comp_opt=-I..
+
+ +

Note that there must be no trailing spaces. +

+

In buffer hello_3.adb, invoke ‘Ada | Project | Load...’, and +select Example_3/Other/other.adp. +

+

Then, again in hello_3.adb, invoke ‘Ada | Set main and +Build’. You should get a *compilation* buffer containing +something like (the directory paths will be different): +

+
+
cd c:/Examples/Example_3/Other/
+gnatmake -o hello_3 hello_3 -g -cargs -I.. -bargs  -largs
+gcc -c -g -I.. hello_3.adb
+gcc -c -I./ -g -I.. -I- C:\Examples\Example_3\hello_pkg.adb
+hello_pkg.adb:2:08: keyword "body" expected here [see file name]
+gnatmake: "C:\Examples\Example_3\hello_pkg.adb" compilation error
+
+ +

Compare the -cargs option to the compiler output in Set compiler options; this shows that other.adp is being used to +set the compiler options. +

+

Move to the error with C-x `. Ada mode searches the list of +directories given by src_dir for the file mentioned in the +compiler error message. +

+

Fixing the error, linking and running the code proceed as in No project files. +

+
+
+
+ +

6.4 Use GNAT project file

+ +

In this example, we show how to use a GNAT project file, with no Ada +mode project file. +

+

Create the directory Example_4, containing: +

+

hello_pkg.ads: +

+
+
package Hello_Pkg is
+   procedure Say_Hello;
+end Hello_Pkg;
+
+ +

hello_pkg.adb: +

+
+
with Ada.Text_IO;
+package Hello_Pkg is
+   procedure Say_Hello
+   is begin
+      Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb");
+   end Say_Hello;
+end Hello_Pkg;
+
+ +

These are the same files from example 1; hello_pkg.adb has an +error on line 2. +

+

In addition, create a directory Example_4/Gnat_Project, +containing these files: +

+

Gnat_Project/hello_4.adb: +

+
+
with Hello_Pkg;
+with Ada.Text_IO; use Ada.Text_IO;
+procedure Hello_4
+is begin
+   Hello_Pkg.Say_Hello;
+   Put_Line ("From hello_4");
+end Hello_4;
+
+ +

There are no errors in this file. +

+

Gnat_Project/hello_4.gpr: +

+
+
Project Hello_4 is
+   for Source_Dirs use (".", "..");
+end Hello_4;
+
+ +

In buffer hello_4.adb, invoke ‘Ada | Project | Load...’, and +select Example_4/Gnat_Project/hello_4.gpr. +

+

Then, again in hello_4.adb, invoke ‘Ada | Set main and +Build’. You should get a *compilation* buffer containing +something like (the directory paths will be different): +

+
+
cd c:/Examples/Example_4/Gnat_Project/
+gnatmake -o hello_4 hello_4 -Phello_4.gpr -cargs -gnatq -gnatQ -bargs  -largs
+gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\Gnat_Project\hello_4.adb
+gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb
+hello_pkg.adb:2:08: keyword "body" expected here [see file name]
+gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error
+
+ +

Compare the gcc options to the compiler output in Set compiler options; this shows that hello_4.gpr is being used to +set the compiler options. +

+

Fixing the error, linking and running the code proceed as in No project files. +

+
+
+
+ +

6.5 Use multiple GNAT project files

+ +

In this example, we show how to use multiple GNAT project files, +specifying the GNAT project search path in an Ada mode project file. +

+

Create the directory Example_4 as specified in Use GNAT project file. +

+

Create the directory Example_5, containing: +

+

hello_5.adb: +

+
+
with Hello_Pkg;
+with Ada.Text_IO; use Ada.Text_IO;
+procedure Hello_5
+is begin
+   Hello_Pkg.Say_Hello;
+   Put_Line ("From hello_5");
+end Hello_5;
+
+ +

There are no errors in this file. +

+

hello_5.adp: +

+
+
ada_project_path=../Example_4/Gnat_Project
+gpr_file=hello_5.gpr
+
+ +

hello_5.gpr: +

+
+
with "hello_4";
+Project Hello_5 is
+   for Source_Dirs use (".");
+   package Compiler is
+      for Default_Switches ("Ada") use ("-g", "-gnatyt");
+   end Compiler;
+end Hello_5;
+
+ +

In buffer hello_5.adb, invoke ‘Ada | Project | Load...’, and +select Example_5/hello_5.adp. +

+

Then, again in hello_5.adb, invoke ‘Ada | Set main and +Build’. You should get a *compilation* buffer containing +something like (the directory paths will be different): +

+
+
cd c:/Examples/Example_5/
+gnatmake -o hello_5 hello_5 -Phello_5.gpr -g -cargs -gnatq -gnatQ -bargs  -largs
+gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_5\hello_5.adb
+gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb
+hello_pkg.adb:2:08: keyword "body" expected here [see file name]
+gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error
+
+ +

Now type C-x `. Example_4/hello_pkg.adb is shown, +demonstrating that hello_5.gpr and hello_4.gpr are being +used to set the compilation search path. +

+
+
+
+
+ +

7 Moving Through Ada Code

+ +

There are several easy to use commands to navigate through Ada code. All +these functions are available through the Ada menu, and you can also +use the following key bindings or the command names. Some of these +menu entries are available only if the GNAT compiler is used, since +the implementation relies on the GNAT cross-referencing information. +

+
+
M-C-e
+

Move to the next function/procedure/task, which ever comes next +(ada-next-procedure). +

+
M-C-a
+

Move to previous function/procedure/task +(ada-previous-procedure). +

+
M-x ada-next-package
+

Move to next package. +

+
M-x ada-previous-package
+

Move to previous package. +

+
C-c C-a
+

Move to matching start of end (ada-move-to-start). If +point is at the end of a subprogram, this command jumps to the +corresponding begin if the user option +ada-move-to-declaration is nil (default), otherwise it jumps to +the subprogram declaration. +

+
C-c C-e
+

Move point to end of current block (ada-move-to-end). +

+
C-c o
+

Switch between corresponding spec and body file +(ff-find-other-file). If point is in a subprogram, position +point on the corresponding declaration or body in the other file. +

+
C-c c-d
+

Move from any reference to its declaration, for from a declaration to +its body (for procedures, tasks, private and incomplete types). +

+
C-c C-r
+

Runs the gnatfind command to search for all references to the +identifier surrounding point (ada-find-references). Use +C-x ` (next-error) to visit each reference (as for +compilation errors). +

+
+ +

If the ada-xref-create-ali variable is non-nil, Emacs +will try to run GNAT for you whenever cross-reference information is +needed, and is older than the current source file. +

+
+
+
+ +

8 Identifier completion

+ +

Emacs and Ada mode provide two general ways for the completion of +identifiers. This is an easy way to type faster: you just have to type +the first few letters of an identifiers, and then loop through all the +possible completions. +

+

The first method is general for Emacs. It works by parsing all open +files for possible completions. +

+

For instance, if the words ‘my_identifier’, ‘my_subprogram’ +are the only words starting with ‘my’ in any of the opened files, +then you will have this scenario: +

+
+
You type:  myM-/
+Emacs inserts:  ‘my_identifier’
+If you press M-/ once again, Emacs replaces ‘my_identifier’ with
+‘my_subprogram’.
+Pressing M-/ once more will bring you back to ‘my_identifier’.
+
+ +

This is a very fast way to do completion, and the casing of words will +also be respected. +

+

The second method (C-TAB) is specific to Ada mode and the GNAT +compiler. Emacs will search the cross-information for possible +completions. +

+

The main advantage is that this completion is more accurate: only +existing identifier will be suggested. +

+

On the other hand, this completion is a little bit slower and requires +that you have compiled your file at least once since you created that +identifier. +

+
+
C-TAB
+

Complete current identifier using cross-reference information. +

+
M-/
+

Complete identifier using buffer information (not Ada-specific). +

+
+ +
+
+
+ +

9 Automatic Smart Indentation

+ +

Ada mode comes with a full set of rules for automatic indentation. You +can also configure the indentation, via the following variables: +

+
+
ada-broken-indent (default value: 2)
+

Number of columns to indent the continuation of a broken line. +

+
+
ada-indent (default value: 3)
+

Number of columns for default indentation. +

+
+
ada-indent-record-rel-type (default value: 3)
+

Indentation for record relative to type or use. +

+
+
ada-indent-return (default value: 0)
+

Indentation for return relative to function (if +ada-indent-return is greater than 0), or the open parenthesis +(if ada-indent-return is negative or 0). Note that in the second +case, when there is no open parenthesis, the indentation is done +relative to function with the value of ada-broken-indent. +

+
+
ada-label-indent (default value: -4)
+

Number of columns to indent a label. +

+
+
ada-stmt-end-indent (default value: 0)
+

Number of columns to indent a statement end keyword on a separate line. +

+
+
ada-when-indent (default value: 3)
+

Indentation for when relative to exception or case. +

+
+
ada-indent-is-separate (default value: t)
+

Non-nil means indent is separate or is abstract if on a single line. +

+
+
ada-indent-to-open-paren (default value: t)
+

Non-nil means indent according to the innermost open parenthesis. +

+
+
ada-indent-after-return (default value: t)
+

Non-nil means that the current line will also be re-indented +before inserting a newline, when you press RET. +

+
+ +

Most of the time, the indentation will be automatic, i.e., when you +press RET, the cursor will move to the correct column on the +next line. +

+

You can also indent single lines, or the current region, with TAB. +

+

Another mode of indentation exists that helps you to set up your +indentation scheme. If you press C-c TAB, Ada mode will do +the following: +

+
    +
  • Reindent the current line, as TAB would do. +
  • Temporarily move the cursor to a reference line, i.e., the line that +was used to calculate the current indentation. +
  • Display in the message window the name of the variable that provided +the offset for the indentation. +
+ +

The exact indentation of the current line is the same as the one for the +reference line, plus an offset given by the variable. +

+
+
TAB
+

Indent the current line or the current region. +

+
C-M-\
+

Indent lines in the current region. +

+
C-c TAB
+

Indent the current line and display the name of the variable used for +indentation. +

+
+ +
+
+
+ +

10 Formatting Parameter Lists

+ +
+
C-c C-f
+

Format the parameter list (ada-format-paramlist). +

+
+ +

This aligns the declarations on the colon (‘:’) separating +argument names and argument types, and aligns the in, +out and in out keywords. +

+
+
+
+ +

11 Automatic Casing

+ +

Casing of identifiers, attributes and keywords is automatically +performed while typing when the variable ada-auto-case is set. +Every time you press a word separator, the previous word is +automatically cased. +

+

You can customize the automatic casing differently for keywords, +attributes and identifiers. The relevant variables are the following: +ada-case-keyword, ada-case-attribute and +ada-case-identifier. +

+

All these variables can have one of the following values: +

+
+
downcase-word
+

The word will be lowercase. For instance My_vARIable is +converted to my_variable. +

+
+
upcase-word
+

The word will be uppercase. For instance My_vARIable is +converted to MY_VARIABLE. +

+
+
ada-capitalize-word
+

The first letter and each letter following an underscore (‘_’) +are uppercase, others are lowercase. For instance My_vARIable +is converted to My_Variable. +

+
+
ada-loose-case-word
+

Characters after an underscore ‘_’ character are uppercase, +others are not modified. For instance My_vARIable is converted +to My_VARIable. +

+
+ +

Ada mode allows you to define exceptions to these rules, in a file +specified by the variable ada-case-exception-file +(default ~/.emacs_case_exceptions). Each line in this file +specifies the casing of one word or word fragment. Comments may be +included, separated from the word by a space. +

+

If the word starts with an asterisk (‘*’), it defines the casing +as a word fragment (or “substring”); part of a word between two +underscores or word boundary. +

+

For example: +

+
+
DOD        Department of Defense
+*IO
+GNAT       The GNAT compiler from Ada Core Technologies
+
+ +

The word fragment *IO applies to any word containing “_io”; +Text_IO, Hardware_IO, etc. +

+ +

There are two ways to add new items to this file: you can simply edit +it as you would edit any text file. Or you can position point on the +word you want to add, and select menu ‘Ada | Edit | Create Case +Exception’, or press C-c C-y (ada-create-case-exception). +The word will automatically be added to the current list of exceptions +and to the file. +

+

To define a word fragment case exception, select the word fragment, +then select menu ‘Ada | Edit | Create Case Exception Substring’. +

+

It is sometimes useful to have multiple exception files around (for +instance, one could be the standard Ada acronyms, the second some +company specific exceptions, and the last one some project specific +exceptions). If you set up the variable ada-case-exception-file +as a list of files, each of them will be parsed and used in your emacs +session. However, when you save a new exception through the menu, as +described above, the new exception will be added to the first file in +the list. +

+
+
C-c C-b
+

Adjust case in the whole buffer (ada-adjust-case-buffer). +

+
C-c C-y
+

Create a new entry in the exception dictionary, with the word under +the cursor (ada-create-case-exception) +

+
C-c C-t
+

Rereads the exception dictionary from the file +ada-case-exception-file (ada-case-read-exceptions). +

+
+ +
+
+
+
+

+Next: , Previous: , Up: Ada Mode   [Contents][Index]

+
+

12 Statement Templates

+ +

Templates are defined for most Ada statements, using the Emacs +“skeleton” package. They can be inserted in the buffer using the +following commands: +

+
+
C-c t b
+

exception Block (ada-exception-block). +

+
C-c t c
+

case (ada-case). +

+
C-c t d
+

declare Block (ada-declare-block). +

+
C-c t e
+

else (ada-else). +

+
C-c t f
+

for Loop (ada-for-loop). +

+
C-c t h
+

Header (ada-header). +

+
C-c t i
+

if (ada-if). +

+
C-c t k
+

package Body (ada-package-body). +

+
C-c t l
+

loop (ada-loop). +

+
C-c p
+

subprogram body (ada-subprogram-body). +

+
C-c t t
+

task Body (ada-task-body). +

+
C-c t w
+

while Loop (ada-while). +

+
C-c t u
+

use (ada-use). +

+
C-c t x
+

exit (ada-exit). +

+
C-c t C-a
+

array (ada-array). +

+
C-c t C-e
+

elsif (ada-elsif). +

+
C-c t C-f
+

function Spec (ada-function-spec). +

+
C-c t C-k
+

package Spec (ada-package-spec). +

+
C-c t C-p
+

procedure Spec (ada-package-spec. +

+
C-c t C-r
+

record (ada-record). +

+
C-c t C-s
+

subtype (ada-subtype). +

+
C-c t C-t
+

task Spec (ada-task-spec). +

+
C-c t C-u
+

with (ada-with). +

+
C-c t C-v
+

private (ada-private). +

+
C-c t C-w
+

when (ada-when). +

+
C-c t C-x
+

exception (ada-exception). +

+
C-c t C-y
+

type (ada-type). +

+
+ +
+
+
+ +

13 Comment Handling

+ +

By default, comment lines get indented like Ada code. There are a few +additional functions to handle comments: +

+
+
M-;
+

Start a comment in default column. +

+
M-j
+

Continue comment on next line. +

+
C-c ;
+

Comment the selected region (add ‘--’ at the beginning of lines). +

+
C-c :
+

Uncomment the selected region +

+
M-q
+

autofill the current comment. +

+
+ +
+
+
+
+

+Next: , Previous: , Up: Ada Mode   [Contents][Index]

+
+

Appendix A GNU Free Documentation License

+
Version 1.3, 3 November 2008 +
+ +
+
Copyright © 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
+https://fsf.org/
+
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+
+ +
    +
  1. PREAMBLE + +

    The purpose of this License is to make a manual, textbook, or other +functional and useful document free in the sense of freedom: to +assure everyone the effective freedom to copy and redistribute it, +with or without modifying it, either commercially or noncommercially. +Secondarily, this License preserves for the author and publisher a way +to get credit for their work, while not being considered responsible +for modifications made by others. +

    +

    This License is a kind of “copyleft”, which means that derivative +works of the document must themselves be free in the same sense. It +complements the GNU General Public License, which is a copyleft +license designed for free software. +

    +

    We have designed this License in order to use it for manuals for free +software, because free software needs free documentation: a free +program should come with manuals providing the same freedoms that the +software does. But this License is not limited to software manuals; +it can be used for any textual work, regardless of subject matter or +whether it is published as a printed book. We recommend this License +principally for works whose purpose is instruction or reference. +

    +
  2. APPLICABILITY AND DEFINITIONS + +

    This License applies to any manual or other work, in any medium, that +contains a notice placed by the copyright holder saying it can be +distributed under the terms of this License. Such a notice grants a +world-wide, royalty-free license, unlimited in duration, to use that +work under the conditions stated herein. The “Document”, below, +refers to any such manual or work. Any member of the public is a +licensee, and is addressed as “you”. You accept the license if you +copy, modify or distribute the work in a way requiring permission +under copyright law. +

    +

    A “Modified Version” of the Document means any work containing the +Document or a portion of it, either copied verbatim, or with +modifications and/or translated into another language. +

    +

    A “Secondary Section” is a named appendix or a front-matter section +of the Document that deals exclusively with the relationship of the +publishers or authors of the Document to the Document’s overall +subject (or to related matters) and contains nothing that could fall +directly within that overall subject. (Thus, if the Document is in +part a textbook of mathematics, a Secondary Section may not explain +any mathematics.) The relationship could be a matter of historical +connection with the subject or with related matters, or of legal, +commercial, philosophical, ethical or political position regarding +them. +

    +

    The “Invariant Sections” are certain Secondary Sections whose titles +are designated, as being those of Invariant Sections, in the notice +that says that the Document is released under this License. If a +section does not fit the above definition of Secondary then it is not +allowed to be designated as Invariant. The Document may contain zero +Invariant Sections. If the Document does not identify any Invariant +Sections then there are none. +

    +

    The “Cover Texts” are certain short passages of text that are listed, +as Front-Cover Texts or Back-Cover Texts, in the notice that says that +the Document is released under this License. A Front-Cover Text may +be at most 5 words, and a Back-Cover Text may be at most 25 words. +

    +

    A “Transparent” copy of the Document means a machine-readable copy, +represented in a format whose specification is available to the +general public, that is suitable for revising the document +straightforwardly with generic text editors or (for images composed of +pixels) generic paint programs or (for drawings) some widely available +drawing editor, and that is suitable for input to text formatters or +for automatic translation to a variety of formats suitable for input +to text formatters. A copy made in an otherwise Transparent file +format whose markup, or absence of markup, has been arranged to thwart +or discourage subsequent modification by readers is not Transparent. +An image format is not Transparent if used for any substantial amount +of text. A copy that is not “Transparent” is called “Opaque”. +

    +

    Examples of suitable formats for Transparent copies include plain +ASCII without markup, Texinfo input format, LaTeX input +format, SGML or XML using a publicly available +DTD, and standard-conforming simple HTML, +PostScript or PDF designed for human modification. Examples +of transparent image formats include PNG, XCF and +JPG. Opaque formats include proprietary formats that can be +read and edited only by proprietary word processors, SGML or +XML for which the DTD and/or processing tools are +not generally available, and the machine-generated HTML, +PostScript or PDF produced by some word processors for +output purposes only. +

    +

    The “Title Page” means, for a printed book, the title page itself, +plus such following pages as are needed to hold, legibly, the material +this License requires to appear in the title page. For works in +formats which do not have any title page as such, “Title Page” means +the text near the most prominent appearance of the work’s title, +preceding the beginning of the body of the text. +

    +

    The “publisher” means any person or entity that distributes copies +of the Document to the public. +

    +

    A section “Entitled XYZ” means a named subunit of the Document whose +title either is precisely XYZ or contains XYZ in parentheses following +text that translates XYZ in another language. (Here XYZ stands for a +specific section name mentioned below, such as “Acknowledgements”, +“Dedications”, “Endorsements”, or “History”.) To “Preserve the Title” +of such a section when you modify the Document means that it remains a +section “Entitled XYZ” according to this definition. +

    +

    The Document may include Warranty Disclaimers next to the notice which +states that this License applies to the Document. These Warranty +Disclaimers are considered to be included by reference in this +License, but only as regards disclaiming warranties: any other +implication that these Warranty Disclaimers may have is void and has +no effect on the meaning of this License. +

    +
  3. VERBATIM COPYING + +

    You may copy and distribute the Document in any medium, either +commercially or noncommercially, provided that this License, the +copyright notices, and the license notice saying this License applies +to the Document are reproduced in all copies, and that you add no other +conditions whatsoever to those of this License. You may not use +technical measures to obstruct or control the reading or further +copying of the copies you make or distribute. However, you may accept +compensation in exchange for copies. If you distribute a large enough +number of copies you must also follow the conditions in section 3. +

    +

    You may also lend copies, under the same conditions stated above, and +you may publicly display copies. +

    +
  4. COPYING IN QUANTITY + +

    If you publish printed copies (or copies in media that commonly have +printed covers) of the Document, numbering more than 100, and the +Document’s license notice requires Cover Texts, you must enclose the +copies in covers that carry, clearly and legibly, all these Cover +Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on +the back cover. Both covers must also clearly and legibly identify +you as the publisher of these copies. The front cover must present +the full title with all words of the title equally prominent and +visible. You may add other material on the covers in addition. +Copying with changes limited to the covers, as long as they preserve +the title of the Document and satisfy these conditions, can be treated +as verbatim copying in other respects. +

    +

    If the required texts for either cover are too voluminous to fit +legibly, you should put the first ones listed (as many as fit +reasonably) on the actual cover, and continue the rest onto adjacent +pages. +

    +

    If you publish or distribute Opaque copies of the Document numbering +more than 100, you must either include a machine-readable Transparent +copy along with each Opaque copy, or state in or with each Opaque copy +a computer-network location from which the general network-using +public has access to download using public-standard network protocols +a complete Transparent copy of the Document, free of added material. +If you use the latter option, you must take reasonably prudent steps, +when you begin distribution of Opaque copies in quantity, to ensure +that this Transparent copy will remain thus accessible at the stated +location until at least one year after the last time you distribute an +Opaque copy (directly or through your agents or retailers) of that +edition to the public. +

    +

    It is requested, but not required, that you contact the authors of the +Document well before redistributing any large number of copies, to give +them a chance to provide you with an updated version of the Document. +

    +
  5. MODIFICATIONS + +

    You may copy and distribute a Modified Version of the Document under +the conditions of sections 2 and 3 above, provided that you release +the Modified Version under precisely this License, with the Modified +Version filling the role of the Document, thus licensing distribution +and modification of the Modified Version to whoever possesses a copy +of it. In addition, you must do these things in the Modified Version: +

    +
      +
    1. Use in the Title Page (and on the covers, if any) a title distinct +from that of the Document, and from those of previous versions +(which should, if there were any, be listed in the History section +of the Document). You may use the same title as a previous version +if the original publisher of that version gives permission. + +
    2. List on the Title Page, as authors, one or more persons or entities +responsible for authorship of the modifications in the Modified +Version, together with at least five of the principal authors of the +Document (all of its principal authors, if it has fewer than five), +unless they release you from this requirement. + +
    3. State on the Title page the name of the publisher of the +Modified Version, as the publisher. + +
    4. Preserve all the copyright notices of the Document. + +
    5. Add an appropriate copyright notice for your modifications +adjacent to the other copyright notices. + +
    6. Include, immediately after the copyright notices, a license notice +giving the public permission to use the Modified Version under the +terms of this License, in the form shown in the Addendum below. + +
    7. Preserve in that license notice the full lists of Invariant Sections +and required Cover Texts given in the Document’s license notice. + +
    8. Include an unaltered copy of this License. + +
    9. Preserve the section Entitled “History”, Preserve its Title, and add +to it an item stating at least the title, year, new authors, and +publisher of the Modified Version as given on the Title Page. If +there is no section Entitled “History” in the Document, create one +stating the title, year, authors, and publisher of the Document as +given on its Title Page, then add an item describing the Modified +Version as stated in the previous sentence. + +
    10. Preserve the network location, if any, given in the Document for +public access to a Transparent copy of the Document, and likewise +the network locations given in the Document for previous versions +it was based on. These may be placed in the “History” section. +You may omit a network location for a work that was published at +least four years before the Document itself, or if the original +publisher of the version it refers to gives permission. + +
    11. For any section Entitled “Acknowledgements” or “Dedications”, Preserve +the Title of the section, and preserve in the section all the +substance and tone of each of the contributor acknowledgements and/or +dedications given therein. + +
    12. Preserve all the Invariant Sections of the Document, +unaltered in their text and in their titles. Section numbers +or the equivalent are not considered part of the section titles. + +
    13. Delete any section Entitled “Endorsements”. Such a section +may not be included in the Modified Version. + +
    14. Do not retitle any existing section to be Entitled “Endorsements” or +to conflict in title with any Invariant Section. + +
    15. Preserve any Warranty Disclaimers. +
    + +

    If the Modified Version includes new front-matter sections or +appendices that qualify as Secondary Sections and contain no material +copied from the Document, you may at your option designate some or all +of these sections as invariant. To do this, add their titles to the +list of Invariant Sections in the Modified Version’s license notice. +These titles must be distinct from any other section titles. +

    +

    You may add a section Entitled “Endorsements”, provided it contains +nothing but endorsements of your Modified Version by various +parties—for example, statements of peer review or that the text has +been approved by an organization as the authoritative definition of a +standard. +

    +

    You may add a passage of up to five words as a Front-Cover Text, and a +passage of up to 25 words as a Back-Cover Text, to the end of the list +of Cover Texts in the Modified Version. Only one passage of +Front-Cover Text and one of Back-Cover Text may be added by (or +through arrangements made by) any one entity. If the Document already +includes a cover text for the same cover, previously added by you or +by arrangement made by the same entity you are acting on behalf of, +you may not add another; but you may replace the old one, on explicit +permission from the previous publisher that added the old one. +

    +

    The author(s) and publisher(s) of the Document do not by this License +give permission to use their names for publicity for or to assert or +imply endorsement of any Modified Version. +

    +
  6. COMBINING DOCUMENTS + +

    You may combine the Document with other documents released under this +License, under the terms defined in section 4 above for modified +versions, provided that you include in the combination all of the +Invariant Sections of all of the original documents, unmodified, and +list them all as Invariant Sections of your combined work in its +license notice, and that you preserve all their Warranty Disclaimers. +

    +

    The combined work need only contain one copy of this License, and +multiple identical Invariant Sections may be replaced with a single +copy. If there are multiple Invariant Sections with the same name but +different contents, make the title of each such section unique by +adding at the end of it, in parentheses, the name of the original +author or publisher of that section if known, or else a unique number. +Make the same adjustment to the section titles in the list of +Invariant Sections in the license notice of the combined work. +

    +

    In the combination, you must combine any sections Entitled “History” +in the various original documents, forming one section Entitled +“History”; likewise combine any sections Entitled “Acknowledgements”, +and any sections Entitled “Dedications”. You must delete all +sections Entitled “Endorsements.” +

    +
  7. COLLECTIONS OF DOCUMENTS + +

    You may make a collection consisting of the Document and other documents +released under this License, and replace the individual copies of this +License in the various documents with a single copy that is included in +the collection, provided that you follow the rules of this License for +verbatim copying of each of the documents in all other respects. +

    +

    You may extract a single document from such a collection, and distribute +it individually under this License, provided you insert a copy of this +License into the extracted document, and follow this License in all +other respects regarding verbatim copying of that document. +

    +
  8. AGGREGATION WITH INDEPENDENT WORKS + +

    A compilation of the Document or its derivatives with other separate +and independent documents or works, in or on a volume of a storage or +distribution medium, is called an “aggregate” if the copyright +resulting from the compilation is not used to limit the legal rights +of the compilation’s users beyond what the individual works permit. +When the Document is included in an aggregate, this License does not +apply to the other works in the aggregate which are not themselves +derivative works of the Document. +

    +

    If the Cover Text requirement of section 3 is applicable to these +copies of the Document, then if the Document is less than one half of +the entire aggregate, the Document’s Cover Texts may be placed on +covers that bracket the Document within the aggregate, or the +electronic equivalent of covers if the Document is in electronic form. +Otherwise they must appear on printed covers that bracket the whole +aggregate. +

    +
  9. TRANSLATION + +

    Translation is considered a kind of modification, so you may +distribute translations of the Document under the terms of section 4. +Replacing Invariant Sections with translations requires special +permission from their copyright holders, but you may include +translations of some or all Invariant Sections in addition to the +original versions of these Invariant Sections. You may include a +translation of this License, and all the license notices in the +Document, and any Warranty Disclaimers, provided that you also include +the original English version of this License and the original versions +of those notices and disclaimers. In case of a disagreement between +the translation and the original version of this License or a notice +or disclaimer, the original version will prevail. +

    +

    If a section in the Document is Entitled “Acknowledgements”, +“Dedications”, or “History”, the requirement (section 4) to Preserve +its Title (section 1) will typically require changing the actual +title. +

    +
  10. TERMINATION + +

    You may not copy, modify, sublicense, or distribute the Document +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense, or distribute it is void, and +will automatically terminate your rights under this License. +

    +

    However, if you cease all violation of this License, then your license +from a particular copyright holder is reinstated (a) provisionally, +unless and until the copyright holder explicitly and finally +terminates your license, and (b) permanently, if the copyright holder +fails to notify you of the violation by some reasonable means prior to +60 days after the cessation. +

    +

    Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. +

    +

    Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, receipt of a copy of some or all of the same material does +not give you any rights to use it. +

    +
  11. FUTURE REVISIONS OF THIS LICENSE + +

    The Free Software Foundation may publish new, revised versions +of the GNU Free Documentation License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. See +https://www.gnu.org/licenses/. +

    +

    Each version of the License is given a distinguishing version number. +If the Document specifies that a particular numbered version of this +License “or any later version” applies to it, you have the option of +following the terms and conditions either of that specified version or +of any later version that has been published (not as a draft) by the +Free Software Foundation. If the Document does not specify a version +number of this License, you may choose any version ever published (not +as a draft) by the Free Software Foundation. If the Document +specifies that a proxy can decide which future versions of this +License can be used, that proxy’s public statement of acceptance of a +version permanently authorizes you to choose that version for the +Document. +

    +
  12. RELICENSING + +

    “Massive Multiauthor Collaboration Site” (or “MMC Site”) means any +World Wide Web server that publishes copyrightable works and also +provides prominent facilities for anybody to edit those works. A +public wiki that anybody can edit is an example of such a server. A +“Massive Multiauthor Collaboration” (or “MMC”) contained in the +site means any set of copyrightable works thus published on the MMC +site. +

    +

    “CC-BY-SA” means the Creative Commons Attribution-Share Alike 3.0 +license published by Creative Commons Corporation, a not-for-profit +corporation with a principal place of business in San Francisco, +California, as well as future copyleft versions of that license +published by that same organization. +

    +

    “Incorporate” means to publish or republish a Document, in whole or +in part, as part of another Document. +

    +

    An MMC is “eligible for relicensing” if it is licensed under this +License, and if all works that were first published under this License +somewhere other than this MMC, and subsequently incorporated in whole +or in part into the MMC, (1) had no cover texts or invariant sections, +and (2) were thus incorporated prior to November 1, 2008. +

    +

    The operator of an MMC Site may republish an MMC contained in the site +under CC-BY-SA on the same site at any time before August 1, 2009, +provided the MMC is eligible for relicensing. +

    +
+ +

ADDENDUM: How to use this License for your documents

+ +

To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and +license notices just after the title page: +

+
+
  Copyright (C)  year  your name.
+  Permission is granted to copy, distribute and/or modify this document
+  under the terms of the GNU Free Documentation License, Version 1.3
+  or any later version published by the Free Software Foundation;
+  with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
+  Texts.  A copy of the license is included in the section entitled ``GNU
+  Free Documentation License''.
+
+ +

If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, +replace the “with…Texts.” line with this: +

+
+
    with the Invariant Sections being list their titles, with
+    the Front-Cover Texts being list, and with the Back-Cover Texts
+    being list.
+
+ +

If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. +

+

If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of +free software license, such as the GNU General Public License, +to permit their use in free software. +

+ +
+
+
+ +

Index

+ +
Jump to:   A +   +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Index Entry  Section

A
ada-adjust-case-buffer: Automatic Casing
ada-array: Statement Templates
ada-case: Statement Templates
ada-case-read-exceptions: Automatic Casing
ada-complete-identifier: Identifier completion
ada-create-case-exception: Automatic Casing
ada-declare-block: Statement Templates
ada-else: Statement Templates
ada-elsif: Statement Templates
ada-exception: Statement Templates
ada-exception-block: Statement Templates
ada-exit: Statement Templates
ada-find-references: Moving Through Ada Code
ada-for-loop: Statement Templates
ada-format-paramlist: Formatting Parameter Lists
ada-function-spec: Statement Templates
ada-goto-declaration: Moving Through Ada Code
ada-header: Statement Templates
ada-if: Statement Templates
ada-loop: Statement Templates
ada-move-to-end: Moving Through Ada Code
ada-move-to-start: Moving Through Ada Code
ada-next-package: Moving Through Ada Code
ada-next-procedure: Moving Through Ada Code
ada-package-body: Statement Templates
ada-package-spec: Statement Templates
ada-previous-package: Moving Through Ada Code
ada-previous-procedure: Moving Through Ada Code
ada-private: Statement Templates
ada-procedure-spec: Statement Templates
ada-record: Statement Templates
ada-subprogram-body: Statement Templates
ada-subtype: Statement Templates
ada-task-body: Statement Templates
ada-task-spec: Statement Templates
ada-type: Statement Templates
ada-use: Statement Templates
ada-when: Statement Templates
ada-while: Statement Templates
ada-with: Statement Templates

+
Jump to:   A +   +
+ +
+
+ + + + + diff --git a/old-ada/doc/ada-mode.info b/old-ada/doc/ada-mode.info new file mode 100644 index 0000000..e29172d --- /dev/null +++ b/old-ada/doc/ada-mode.info @@ -0,0 +1,1983 @@ +This is ada-mode.info, produced by texi2any version 6.8 from +ada-mode.texi. + +Copyright © 1999–2019 Free Software Foundation, Inc. + + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, with the Front-Cover Texts + being “A GNU Manual”, and with the Back-Cover Texts as in (a) + below. A copy of the license is included in the section entitled + “GNU Free Documentation License”. + + (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and + modify this GNU manual.” +INFO-DIR-SECTION Emacs editing modes +START-INFO-DIR-ENTRY +* Ada mode: (ada-mode). Emacs mode for editing and compiling Ada code. +END-INFO-DIR-ENTRY + + +File: ada-mode.info, Node: Top, Next: Overview, Up: (dir) + +Ada Mode +******** + +Copyright © 1999–2019 Free Software Foundation, Inc. + + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, with the Front-Cover Texts + being “A GNU Manual”, and with the Back-Cover Texts as in (a) + below. A copy of the license is included in the section entitled + “GNU Free Documentation License”. + + (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and + modify this GNU manual.” + +* Menu: + +* Overview:: +* Installation:: Installing Ada mode on your system +* Customization:: Setting up Ada mode to your taste +* Compiling Executing:: Working with your application within Emacs +* Project files:: Describing the organization of your project +* Compiling Examples:: A small tutorial +* Moving Through Ada Code:: Moving easily through Ada sources +* Identifier completion:: Finishing words automatically +* Automatic Smart Indentation:: Indenting your code automatically as you type +* Formatting Parameter Lists:: Formatting subprograms’ parameter lists + automatically +* Automatic Casing:: Adjusting the case of words automatically +* Statement Templates:: Inserting code templates +* Comment Handling:: Reformatting comments easily +* GNU Free Documentation License:: The license for this documentation. +* Index:: + + +File: ada-mode.info, Node: Overview, Next: Installation, Prev: Top, Up: Top + +1 Overview +********** + +The Emacs mode for programming in Ada helps the user in understanding +existing code and facilitates writing new code. + + When the GNU Ada compiler GNAT is used, the cross-reference +information output by the compiler is used to provide powerful code +navigation (jump to definition, find all uses, etc.). + + When you open a file with a file extension of ‘.ads’ or ‘.adb’, Emacs +will automatically load and activate Ada mode. + + Ada mode works without any customization, if you are using the GNAT +compiler () and the GNAT default naming +convention. + + You must customize a few things if you are using a different compiler +or file naming convention; *Note Other compiler::, *Note Non-standard +file names::. + + In addition, you may want to customize the indentation, +capitalization, and other things; *Note Other customization::. + + Finally, for large Ada projects, you will want to set up an Emacs Ada +mode project file for each project; *Note Project files::. Note that +these are different from the GNAT project files used by gnatmake and +other GNAT commands. + + See the Emacs info manual, section ’Running Debuggers Under Emacs’, +for general information on debugging. + + +File: ada-mode.info, Node: Installation, Next: Customization, Prev: Overview, Up: Top + +2 Installation +************** + +Ada mode is part of the standard Emacs distribution; if you use that, no +files need to be installed. + + Ada mode is also available as a separate distribution, from the Emacs +Ada mode website +. The +separate distribution may be more recent. + + For installing the separate distribution, see the ‘README’ file in +the distribution. + + To see what version of Ada mode you have installed, do ‘M-x +ada-mode-version’. + + The following files are provided with the Ada mode distribution: + + • ‘ada-mode.el’: The main file for Ada mode, providing indentation, + formatting of parameter lists, moving through code, comment + handling and automatic casing. + + • ‘ada-prj.el’: GUI editing of Ada mode project files, using Emacs + widgets. + + • ‘ada-stmt.el’: Ada statement templates. + + • ‘ada-xref.el’: GNAT cross-references, completion of identifiers, + and compilation. Also provides project files (which are not + GNAT-specific). + + +File: ada-mode.info, Node: Customization, Next: Compiling Executing, Prev: Installation, Up: Top + +3 Customizing Ada mode +********************** + +Here we assume you are familiar with setting variables in Emacs, either +thru ’customize’ or in elisp (in your ‘.emacs’ file). For a basic +introduction to customize, elisp, and Emacs in general, see the tutorial +in *note The GNU Emacs Manual: (emacs)Top. + + These global Emacs settings are strongly recommended (put them in +your .emacs): + + (global-font-lock-mode t) + (transient-mark-mode t) + + ‘(global-font-lock-mode t)’ turns on syntax highlighting for all +buffers (it is off by default because it may be too slow for some +machines). + + ‘(transient-mark-mode t)’ highlights selected text. + + See the Emacs help for each of these variables for more information. + +* Menu: + +* Non-standard file names:: +* Other compiler:: +* Other customization:: + + +File: ada-mode.info, Node: Non-standard file names, Next: Other compiler, Up: Customization + +3.1 Non-standard file names +=========================== + +By default, Ada mode is configured to use the GNAT file naming +convention, where file names are a simple modification of the Ada names, +and the extension for specs and bodies are ‘.ads’ and ‘.adb’, +respectively. + + Ada mode uses the file extensions to allow moving from a package body +to the corresponding spec and back. + + Ada mode supports a list of alternative file extensions for specs and +bodies. + + For instance, if your spec and bodies files are called ‘UNIT_s.ada’ +and ‘UNIT_b.ada’, respectively, you can add the following to your +‘.emacs’ file: + + (ada-add-extensions "_s.ada" "_b.ada") + + You can define additional extensions: + + (ada-add-extensions ".ads" "_b.ada") + (ada-add-extensions ".ads" ".body") + + This means that whenever Ada mode looks for the body for a file whose +extension is ‘.ads’, it will take the first available file that ends +with either ‘.adb’, ‘_b.ada’ or ‘.body’. + + Similarly, if Ada mode is looking for a spec, it will look for ‘.ads’ +or ‘_s.ada’. + + If the filename is not derived from the Ada name following the GNAT +convention, things are a little more complicated. You then need to +rewrite the function ‘ada-make-filename-from-adaname’. Doing that is +beyond the scope of this manual; see the current definitions in +‘ada-mode.el’ and ‘ada-xref.el’ for examples. + + +File: ada-mode.info, Node: Other compiler, Next: Other customization, Prev: Non-standard file names, Up: Customization + +3.2 Other compiler +================== + +By default, Ada mode is configured to use the GNU Ada compiler GNAT. + + To use a different Ada compiler, you must specify the command lines +used to run that compiler, either in lisp variables or in Emacs Ada mode +project files. See *note Project file variables:: for the list of +project variables, and the corresponding lisp variables. + + +File: ada-mode.info, Node: Other customization, Prev: Other compiler, Up: Customization + +3.3 Other customization +======================= + +All user-settable Ada mode variables can be set via the menu ‘Ada | +Customize’. Click on the ‘Help’ button there for help on using +customize. + + To modify a specific variable, you can directly call the function +‘customize-variable’; just type ‘M-x customize-variable +VARIABLE-NAME ’). + + Alternately, you can specify variable settings in the Emacs +configuration file, ‘.emacs’. This file is coded in Emacs lisp, and the +syntax to set a variable is the following: + (setq variable-name value) + + +File: ada-mode.info, Node: Compiling Executing, Next: Project files, Prev: Customization, Up: Top + +4 Compiling Executing +********************* + +Ada projects can be compiled, linked, and executed using commands on the +Ada menu. All of these commands can be customized via a project file +(*note Project files::), but the defaults are sufficient for using the +GNAT compiler for simple projects (single files, or several files in a +single directory). + + Even when no project file is used, the GUI project editor (menu ‘Ada +| Project | Edit’) shows the settings of the various project file +variables referenced here. + +* Menu: + +* Compile commands:: +* Compiler errors:: + + +File: ada-mode.info, Node: Compile commands, Next: Compiler errors, Up: Compiling Executing + +4.1 Compile commands +==================== + +Here are the commands for building and using an Ada project, as listed +in the Ada menu. + + In multi-file projects, there must be one file that is the main +program. That is given by the ‘main’ project file variable; it defaults +to the current file if not yet set, but is also set by the “set main and +build” command. + +‘Check file’ + Compiles the current file in syntax check mode, by running + ‘check_cmd’ defined in the current project file. This typically + runs faster than full compile mode, speeding up finding and fixing + compilation errors. + + This sets ‘main’ only if it has not been set yet. + +‘Compile file’ + Compiles the current file, by running ‘comp_cmd’ from the current + project file. + + This does not set ‘main’. + +‘Set main and Build’ + Sets ‘main’ to the current file, then executes the Build command. + +‘Show main’ + Display ‘main’ in the message buffer. + +‘Build’ + Compiles all obsolete units of the current ‘main’, and links + ‘main’, by running ‘make_cmd’ from the current project. + + This sets ‘main’ only if it has not been set yet. + +‘Run’ + Executes the main program in a shell, displayed in a separate Emacs + buffer. This runs ‘run_cmd’ from the current project. The + execution buffer allows for interactive input/output. + + To modify the run command, in particular to provide or change the + command line arguments, type ‘C-u’ before invoking the command. + + This command is not available for a cross-compilation toolchain. + + It is important when using these commands to understand how ‘main’ is +used and changed. + + Build runs ’gnatmake’ on the main unit. During a typical +edit/compile session, this is the only command you need to invoke, which +is why it is bound to ‘C-c C-c’. It will compile all files needed by +the main unit, and display compilation errors in any of them. + + Note that Build can be invoked from any Ada buffer; typically you +will be fixing errors in files other than the main, but you don’t have +to switch back to the main to invoke the compiler again. + + Novices and students typically work on single-file Ada projects. In +this case, ‘C-c C-m’ will normally be the only command needed; it will +build the current file, rather than the last-built main. + + There are three ways to change ‘main’: + + 1. Invoke ‘Ada | Set main and Build’, which sets ‘main’ to the current + file. + + 2. Invoke ‘Ada | Project | Edit’, edit ‘main’ and ‘main’, and click + ‘[save]’ + + 3. Invoke ‘Ada | Project | Load’, and load a project file that + specifies ‘main’ + + +File: ada-mode.info, Node: Compiler errors, Prev: Compile commands, Up: Compiling Executing + +4.2 Compiler errors +=================== + +The ‘Check file’, ‘Compile file’, and ‘Build’ commands all place +compilation errors in a separate buffer named ‘*compilation*’. + + Each line in this buffer will become active: you can simply click on +it with the middle button of the mouse, or move point to it and press +. Emacs will then display the relevant source file and put point +on the line and column where the error was found. + + You can also press the ‘C-x `’ key (‘next-error’), and Emacs will +jump to the first error. If you press that key again, it will move you +to the second error, and so on. + + Some error messages might also include references to other files. +These references are also clickable in the same way, or put point after +the line number and press . + + +File: ada-mode.info, Node: Project files, Next: Compiling Examples, Prev: Compiling Executing, Up: Top + +5 Project files +*************** + +An Emacs Ada mode project file specifies what directories hold sources +for your project, and allows you to customize the compilation commands +and other things on a per-project basis. + + Note that Ada mode project files ‘*.adp’ are different than GNAT +compiler project files ‘*.gpr’. However, Emacs Ada mode can use a GNAT +project file to specify the project directories. If no other +customization is needed, a GNAT project file can be used without an +Emacs Ada mode project file. + +* Menu: + +* Project File Overview:: +* GUI Editor:: +* Project file variables:: + + +File: ada-mode.info, Node: Project File Overview, Next: GUI Editor, Up: Project files + +5.1 Project File Overview +========================= + +Project files have a simple syntax; they may be edited directly. Each +line specifies a project variable name and its value, separated by “=”: + src_dir=/Projects/my_project/src_1 + src_dir=/Projects/my_project/src_2 + + Some variables (like ‘src_dir’) are lists; multiple occurrences are +concatenated. + + There must be no space between the variable name and “=”, and no +trailing spaces. + + Alternately, a GUI editor for project files is available (*note GUI +Editor::). It uses Emacs widgets, similar to Emacs customize. + + The GUI editor also provides a convenient way to view current project +settings, if they have been modified using menu commands rather than by +editing the project file. + + After the first Ada mode build command is invoked, there is always a +current project file, given by the lisp variable +‘ada-prj-default-project-file’. Currently, the only way to show the +current project file is to invoke the GUI editor. + + To find the project file the first time, Ada mode uses the following +search algorithm: + + • If ‘ada-prj-default-project-file’ is set, use that. + + • Otherwise, search for a file in the current directory with the same + base name as the Ada file, but extension given by + ‘ada-prj-file-extension’ (default ‘".adp"’). + + • If not found, search for ‘*.adp’ in the current directory; if + several are found, prompt the user to select one. + + • If none are found, use ‘default.adp’ in the current directory (even + if it does not exist). + + This algorithm always sets ‘ada-prj-default-project-file’, even when +the file does not actually exist. + + To change the project file before or after the first one is found, +invoke ‘Ada | Project | Load ...’. + + Or, in lisp, evaluate ‘(ada-set-default-project-file +"/path/file.adp")’. This sets ‘ada-prj-default-project-file’, and reads +the project file. + + You can also specify a GNAT project file to ‘Ada | Project | Load +...’ or ‘ada-set-default-project-file’. Emacs Ada mode checks the file +extension; if it is ‘.gpr’, the file is treated as a GNAT project file. +Any other extension is treated as an Emacs Ada mode project file. + + +File: ada-mode.info, Node: GUI Editor, Next: Project file variables, Prev: Project File Overview, Up: Project files + +5.2 GUI Editor +============== + +The project file editor is invoked with the menu ‘Ada | Projects | +Edit’. + + Once in the buffer for editing the project file, you can save your +modification using the ‘[save]’ button at the bottom of the buffer, or +the ‘C-x C-s’ binding. To cancel your modifications, kill the buffer or +click on the ‘[cancel]’ button. + + +File: ada-mode.info, Node: Project file variables, Prev: GUI Editor, Up: Project files + +5.3 Project file variables +========================== + +The following variables can be defined in a project file; some can also +be defined in lisp variables. + + To set a project variable that is a list, specify each element of the +list on a separate line in the project file. + + Any project variable can be referenced in other project variables, +using a shell-like notation. For instance, if the variable ‘comp_cmd’ +contains ‘${comp_opt}’, the value of the ‘comp_opt’ variable will be +substituted when ‘comp_cmd’ is used. + + In addition, process environment variables can be referenced using +the same syntax, or the normal ‘$var’ syntax. + + Most project variables have defaults that can be changed by setting +lisp variables; the table below identifies the lisp variable for each +project variable. Lisp variables corresponding to project variables +that are lists are lisp lists. + + In general, project variables are evaluated when referenced in Emacs +Ada mode commands. Relative file paths are expanded to absolute +relative to ‘${build_dir}’. + + Here is the list of variables. In the default values, the current +directory ‘"."’ is the project file directory. + +‘ada_project_path_sep’ [default: ‘":" or ";"’] + Path separator for ‘ADA_PROJECT_PATH’. It defaults to the correct + value for a native implementation of GNAT for the current operating + system. The user must override this when using Windows native GNAT + with Cygwin Emacs, and perhaps in other cases. + + Lisp variable: ‘ada-prj-ada-project-path-sep’. + +‘ada_project_path’ [default: ‘""’] + A list of directories to search for GNAT project files. + + If set, the ‘ADA_PROJECT_PATH’ process environment variable is set + to this value in the Emacs process when the Emacs Ada mode project + is selected via menu ‘Ada | Project | Load’. + + For ‘ada_project_path’, relative file paths are expanded to + absolute when the Emacs Ada project file is read, rather than when + the project file is selected. + + For example if the project file is in the directory + ‘/home/myproject’, the environment variable ‘GDS_ROOT’ is set to + ‘/home/shared’, and the project file contains: + ada_project_path_sep=: + ada_project_path=$GDS_ROOT/makerules + ada_project_path=../opentoken + then as a result the environment variable ‘ADA_PROJECT_PATH’ will + be set to ‘"/home/shared/makerules:/home/opentoken/"’. + + The default value is not the current value of this environment + variable, because that will typically have been set by another + project, and will therefore be incorrect for this project. + + If you have the environment variable set correctly for all of your + projects, you do not need to set this project variable. + +‘bind_opt’ [default: ‘""’] + Holds user binder options; used in the default build commands. + + Lisp variable: ‘ada-prj-default-bind-opt’. + +‘build_dir’ [default: ‘"."’] + The compile commands will be issued in this directory. + +‘casing’ [default: ‘("~/.emacs_case_exceptions")’] + List of files containing casing exceptions. See the help on + ‘ada-case-exception-file’ for more info. + + Lisp variable: ‘ada-case-exception-file’. + +‘check_cmd’ [default: ‘"${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current} -cargs ${comp_opt}"’] + Command used to syntax check a single file. The name of the file + is substituted for ‘full_current’. + + Lisp variable: ‘ada-prj-default-check-cmd’ + +‘comp_cmd’ [default: ‘"${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs ${comp_opt}"’] + Command used to compile a single file. The name of the file is + substituted for ‘full_current’. + + Lisp variable: ‘ada-prj-default-comp-cmd’. + +‘comp_opt’ [default: ‘"-gnatq -gnatQ"’] + Holds user compiler options; used in the default compile commands. + The default value tells gnatmake to generate library files for + cross-referencing even when there are errors. + + If source code for the project is in multiple directories, the + appropriate compiler options must be added here. *note Set source + search path:: for examples of this. Alternately, GNAT project + files may be used; *note Use GNAT project file::. + + Lisp variable: ‘ada-prj-default-comp-opt’. + +‘cross_prefix’ [default: ‘""’] + Name of target machine in a cross-compilation environment. Used in + default compile and build commands. + +‘debug_cmd’ [default: ‘"${cross_prefix}gdb ${main}"’] + Command used to debug the application + + Lisp variable: ‘ada-prj-default-debugger’. + +‘debug_post_cmd’ [default: ‘""’] + Command executed after ‘debug_cmd’. + +‘debug_pre_cmd’ [default: ‘"cd ${build_dir}"’] + Command executed before ‘debug_cmd’. + +‘gnatfind_opt’ [default: ‘"-rf"’] + Holds user gnatfind options; used in the default find commands. + + Lisp variable: ‘ada-prj-gnatfind-switches’. + +‘gnatmake_opt’ [default: ‘"-g"’] + Holds user gnatmake options; used in the default build commands. + + Lisp variable: ‘ada-prj-default-gnatmake-opt’. + +‘gpr_file’ [default: ‘""’] + Specify GNAT project file. + + If set, the source and object directories specified in the GNAT + project file are appended to ‘src_dir’ and ‘obj_dir’. This allows + specifying Ada source directories with a GNAT project file, and + other source directories with the Emacs project file. + + In addition, ‘-P{gpr_file}’ is added to the project variable + ‘gnatmake_opt’ whenever it is referenced. With the default project + variables, this passes the project file to all gnatmake commands. + + Lisp variable: ‘ada-prj-default-gpr-file’. + +‘link_opt’ [default: ‘""’] + Holds user linker options; used in the default build commands. + + Lisp variable: ‘ada-prj-default-link-opt’. + +‘main’ [default: current file] + Specifies the name of the executable file for the project; used in + the default build commands. + +‘make_cmd’ [default: ‘"${cross_prefix}gnatmake -o ${main} ${main} ${gnatmake_opt} -cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}"’] + Command used to build the application. + + Lisp variable: ‘ada-prj-default-make-cmd’. + +‘obj_dir’ [default: ‘"."’] + A list of directories to search for library files. Ada mode + searches this list for the ‘.ali’ files generated by GNAT that + contain cross-reference information. + + The compiler commands must place the ‘.ali’ files in one of these + directories; the default commands do that. + +‘remote_machine’ [default: ‘""’] + Name of the machine to log into before issuing the compile and + build commands. If this variable is empty, the command will be run + on the local machine. + +‘run_cmd’ [default: ‘"./${main}"’] + Command used to run the application. + +‘src_dir’ [default: ‘"."’] + A list of directories to search for source files, both for compile + commands and source navigation. + + +File: ada-mode.info, Node: Compiling Examples, Next: Moving Through Ada Code, Prev: Project files, Up: Top + +6 Compiling Examples +******************** + +We present several small projects, and walk thru the process of +compiling, linking, and running them. + + The first example illustrates more Ada mode features than the others; +you should work thru that example before doing the others. + + All of these examples assume you are using GNAT. + + The source for these examples is available on the Emacs Ada mode +website mentioned in *Note Installation::. + +* Menu: + +* No project files:: Just menus +* Set compiler options:: A basic Ada mode project file +* Set source search path:: Source in multiple directories +* Use GNAT project file:: +* Use multiple GNAT project files:: + + +File: ada-mode.info, Node: No project files, Next: Set compiler options, Up: Compiling Examples + +6.1 No project files +==================== + +This example uses no project files. + + First, create a directory ‘Example_1’, containing: + + ‘hello.adb’: + + with Ada.Text_IO; + procedure Hello + is begin + Put_Line("Hello from hello.adb"); + end Hello; + + Yes, this is missing “use Ada.Text_IO;” - we want to demonstrate +compiler error handling. + + ‘hello_2.adb’: + + with Hello_Pkg; + procedure Hello_2 + is begin + Hello_Pkg.Say_Hello; + end Hello_2; + + This file has no errors. + + ‘hello_pkg.ads’: + + package Hello_Pkg is + procedure Say_Hello; + end Hello_Pkg; + + This file has no errors. + + ‘hello_pkg.adb’: + + with Ada.Text_IO; + package Hello_Pkg is + procedure Say_Hello + is begin + Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); + end Say_Hello; + end Hello_Pkg; + + Yes, this is missing the keyword ‘body’; another compiler error +example. + + In buffer ‘hello.adb’, invoke ‘Ada | Check file’. You should get a +‘*compilation*’ buffer containing something like (the directory paths +will be different): + + cd c:/Examples/Example_1/ + gnatmake -u -c -gnatc -g c:/Examples/Example_1/hello.adb -cargs -gnatq -gnatQ + gcc -c -Ic:/Examples/Example_1/ -gnatc -g -gnatq -gnatQ -I- c:/Examples/Example_1/hello.adb + hello.adb:4:04: "Put_Line" is not visible + hello.adb:4:04: non-visible declaration at a-textio.ads:264 + hello.adb:4:04: non-visible declaration at a-textio.ads:260 + gnatmake: "c:/Examples/Example_1/hello.adb" compilation error + + If you have enabled font-lock, the lines with actual errors (starting +with ‘hello.adb’) are highlighted, with the file name in red. + + Now type ‘C-x `’ (on a PC keyboard, <`> is next to <1>). Or you can +click the middle mouse button on the first error line. The compilation +buffer scrolls to put the first error on the top line, and point is put +at the place of the error in the ‘hello.adb’ buffer. + + To fix the error, change the line to be + + Ada.Text_IO.Put_Line ("hello from hello.adb"); + + Now invoke ‘Ada | Show main’; this displays ‘Ada mode main: hello’. + + Now (in buffer ‘hello.adb’), invoke ‘Ada | Build’. You are prompted +to save the file (if you haven’t already). Then the compilation buffer +is displayed again, containing: + + cd c:/Examples/Example_1/ + gnatmake -o hello hello -g -cargs -gnatq -gnatQ -bargs -largs + gcc -c -g -gnatq -gnatQ hello.adb + gnatbind -x hello.ali + gnatlink hello.ali -o hello.exe -g + + The compilation has succeeded without errors; ‘hello.exe’ now exists +in the same directory as ‘hello.adb’. + + Now invoke ‘Ada | Run’. A ‘*run*’ buffer is displayed, containing + + Hello from hello.adb + + Process run finished + + That completes the first part of this example. + + Now we will compile a multi-file project. Open the file +‘hello_2.adb’, and invoke ‘Ada | Set main and Build’. This finds an +error in ‘hello_pkg.adb’: + + cd c:/Examples/Example_1/ + gnatmake -o hello_2 hello_2 -g -cargs -gnatq -gnatQ -bargs -largs + gcc -c -g -gnatq -gnatQ hello_pkg.adb + hello_pkg.adb:2:08: keyword "body" expected here [see file name] + gnatmake: "hello_pkg.adb" compilation error + + This demonstrates that gnatmake finds the files needed by the main +program. However, it cannot find files in a different directory, unless +you use an Emacs Ada mode project file to specify the other directories; +*Note Set source search path::, or a GNAT project file; *note Use GNAT +project file::. + + Invoke ‘Ada | Show main’; this displays ‘Ada mode main: hello_2’. + + Move to the error with ‘C-x `’, and fix the error by adding ‘body’: + + package body Hello_Pkg is + + Now, while still in ‘hello_pkg.adb’, invoke ‘Ada | Build’. gnatmake +successfully builds ‘hello_2’. This demonstrates that Emacs has +remembered the main file, in the project variable ‘main’, and used it +for the Build command. + + Finally, again while in ‘hello_pkg.adb’, invoke ‘Ada | Run’. The +‘*run*’ buffer displays ‘Hello from hello_pkg.adb’. + + One final point. If you switch back to buffer ‘hello.adb’, and +invoke ‘Ada | Run’, ‘hello_2.exe’ will be run. That is because ‘main’ +is still set to ‘hello_2’, as you can see when you invoke ‘Ada | Project +| Edit’. + + There are three ways to change ‘main’: + + 1. Invoke ‘Ada | Set main and Build’, which sets ‘main’ to the current + file. + + 2. Invoke ‘Ada | Project | Edit’, edit ‘main’, and click ‘[save]’ + + 3. Invoke ‘Ada | Project | Load’, and load a project file that + specifies ‘main’ + + +File: ada-mode.info, Node: Set compiler options, Next: Set source search path, Prev: No project files, Up: Compiling Examples + +6.2 Set compiler options +======================== + +This example illustrates using an Emacs Ada mode project file to set a +compiler option. + + If you have files from ‘Example_1’ open in Emacs, you should close +them so you don’t get confused. Use menu ‘File | Close (current +buffer)’. + + In directory ‘Example_2’, create these files: + + ‘hello.adb’: + + with Ada.Text_IO; + procedure Hello + is begin + Put_Line("Hello from hello.adb"); + end Hello; + + This is the same as ‘hello.adb’ from ‘Example_1’. It has two errors; +missing “use Ada.Text_IO;”, and no space between ‘Put_Line’ and its +argument list. + + ‘hello.adp’: + + comp_opt=-gnatyt + + This tells the GNAT compiler to check for token spacing; in +particular, there must be a space preceding a parenthesis. + + In buffer ‘hello.adb’, invoke ‘Ada | Project | Load...’, and select +‘Example_2/hello.adp’. + + Then, again in buffer ‘hello.adb’, invoke ‘Ada | Set main and Build’. +You should get a ‘*compilation*’ buffer containing something like (the +directory paths will be different): + + cd c:/Examples/Example_2/ + gnatmake -o hello hello -g -cargs -gnatyt -bargs -largs + gcc -c -g -gnatyt hello.adb + hello.adb:4:04: "Put_Line" is not visible + hello.adb:4:04: non-visible declaration at a-textio.ads:264 + hello.adb:4:04: non-visible declaration at a-textio.ads:260 + hello.adb:4:12: (style) space required + gnatmake: "hello.adb" compilation error + + Compare this to the compiler output in *note No project files::; the +gnatmake option ‘-cargs -gnatq -gnatQ’ has been replaced by ‘-cargs +-gnaty’, and an additional error is reported in ‘hello.adb’ on line 4. +This shows that ‘hello.adp’ is being used to set the compiler options. + + Fixing the error, linking and running the code proceed as in *note No +project files::. + + +File: ada-mode.info, Node: Set source search path, Next: Use GNAT project file, Prev: Set compiler options, Up: Compiling Examples + +6.3 Set source search path +========================== + +In this example, we show how to deal with files in more than one +directory. We start with the same code as in *note No project files::; +create those files (with the errors present) + + Create the directory ‘Example_3’, containing: + + ‘hello_pkg.ads’: + + package Hello_Pkg is + procedure Say_Hello; + end Hello_Pkg; + + ‘hello_pkg.adb’: + + with Ada.Text_IO; + package Hello_Pkg is + procedure Say_Hello + is begin + Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); + end Say_Hello; + end Hello_Pkg; + + These are the same files from example 1; ‘hello_pkg.adb’ has an error +on line 2. + + In addition, create a directory ‘Example_3/Other’, containing these +files: + + ‘Other/hello_3.adb’: + + with Hello_Pkg; + with Ada.Text_IO; use Ada.Text_IO; + procedure Hello_3 + is begin + Hello_Pkg.Say_Hello; + Put_Line ("From hello_3"); + end Hello_3; + + There are no errors in this file. + + ‘Other/other.adp’: + + src_dir=.. + comp_opt=-I.. + + Note that there must be no trailing spaces. + + In buffer ‘hello_3.adb’, invoke ‘Ada | Project | Load...’, and select +‘Example_3/Other/other.adp’. + + Then, again in ‘hello_3.adb’, invoke ‘Ada | Set main and Build’. You +should get a ‘*compilation*’ buffer containing something like (the +directory paths will be different): + + cd c:/Examples/Example_3/Other/ + gnatmake -o hello_3 hello_3 -g -cargs -I.. -bargs -largs + gcc -c -g -I.. hello_3.adb + gcc -c -I./ -g -I.. -I- C:\Examples\Example_3\hello_pkg.adb + hello_pkg.adb:2:08: keyword "body" expected here [see file name] + gnatmake: "C:\Examples\Example_3\hello_pkg.adb" compilation error + + Compare the ‘-cargs’ option to the compiler output in *note Set +compiler options::; this shows that ‘other.adp’ is being used to set the +compiler options. + + Move to the error with ‘C-x `’. Ada mode searches the list of +directories given by ‘src_dir’ for the file mentioned in the compiler +error message. + + Fixing the error, linking and running the code proceed as in *note No +project files::. + + +File: ada-mode.info, Node: Use GNAT project file, Next: Use multiple GNAT project files, Prev: Set source search path, Up: Compiling Examples + +6.4 Use GNAT project file +========================= + +In this example, we show how to use a GNAT project file, with no Ada +mode project file. + + Create the directory ‘Example_4’, containing: + + ‘hello_pkg.ads’: + + package Hello_Pkg is + procedure Say_Hello; + end Hello_Pkg; + + ‘hello_pkg.adb’: + + with Ada.Text_IO; + package Hello_Pkg is + procedure Say_Hello + is begin + Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); + end Say_Hello; + end Hello_Pkg; + + These are the same files from example 1; ‘hello_pkg.adb’ has an error +on line 2. + + In addition, create a directory ‘Example_4/Gnat_Project’, containing +these files: + + ‘Gnat_Project/hello_4.adb’: + + with Hello_Pkg; + with Ada.Text_IO; use Ada.Text_IO; + procedure Hello_4 + is begin + Hello_Pkg.Say_Hello; + Put_Line ("From hello_4"); + end Hello_4; + + There are no errors in this file. + + ‘Gnat_Project/hello_4.gpr’: + + Project Hello_4 is + for Source_Dirs use (".", ".."); + end Hello_4; + + In buffer ‘hello_4.adb’, invoke ‘Ada | Project | Load...’, and select +‘Example_4/Gnat_Project/hello_4.gpr’. + + Then, again in ‘hello_4.adb’, invoke ‘Ada | Set main and Build’. You +should get a ‘*compilation*’ buffer containing something like (the +directory paths will be different): + + cd c:/Examples/Example_4/Gnat_Project/ + gnatmake -o hello_4 hello_4 -Phello_4.gpr -cargs -gnatq -gnatQ -bargs -largs + gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\Gnat_Project\hello_4.adb + gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb + hello_pkg.adb:2:08: keyword "body" expected here [see file name] + gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error + + Compare the ‘gcc’ options to the compiler output in *note Set +compiler options::; this shows that ‘hello_4.gpr’ is being used to set +the compiler options. + + Fixing the error, linking and running the code proceed as in *note No +project files::. + + +File: ada-mode.info, Node: Use multiple GNAT project files, Prev: Use GNAT project file, Up: Compiling Examples + +6.5 Use multiple GNAT project files +=================================== + +In this example, we show how to use multiple GNAT project files, +specifying the GNAT project search path in an Ada mode project file. + + Create the directory ‘Example_4’ as specified in *note Use GNAT +project file::. + + Create the directory ‘Example_5’, containing: + + ‘hello_5.adb’: + + with Hello_Pkg; + with Ada.Text_IO; use Ada.Text_IO; + procedure Hello_5 + is begin + Hello_Pkg.Say_Hello; + Put_Line ("From hello_5"); + end Hello_5; + + There are no errors in this file. + + ‘hello_5.adp’: + + ada_project_path=../Example_4/Gnat_Project + gpr_file=hello_5.gpr + + ‘hello_5.gpr’: + + with "hello_4"; + Project Hello_5 is + for Source_Dirs use ("."); + package Compiler is + for Default_Switches ("Ada") use ("-g", "-gnatyt"); + end Compiler; + end Hello_5; + + In buffer ‘hello_5.adb’, invoke ‘Ada | Project | Load...’, and select +‘Example_5/hello_5.adp’. + + Then, again in ‘hello_5.adb’, invoke ‘Ada | Set main and Build’. You +should get a ‘*compilation*’ buffer containing something like (the +directory paths will be different): + + cd c:/Examples/Example_5/ + gnatmake -o hello_5 hello_5 -Phello_5.gpr -g -cargs -gnatq -gnatQ -bargs -largs + gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_5\hello_5.adb + gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb + hello_pkg.adb:2:08: keyword "body" expected here [see file name] + gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error + + Now type ‘C-x `’. ‘Example_4/hello_pkg.adb’ is shown, demonstrating +that ‘hello_5.gpr’ and ‘hello_4.gpr’ are being used to set the +compilation search path. + + +File: ada-mode.info, Node: Moving Through Ada Code, Next: Identifier completion, Prev: Compiling Examples, Up: Top + +7 Moving Through Ada Code +************************* + +There are several easy to use commands to navigate through Ada code. +All these functions are available through the Ada menu, and you can also +use the following key bindings or the command names. Some of these menu +entries are available only if the GNAT compiler is used, since the +implementation relies on the GNAT cross-referencing information. + +‘M-C-e’ + Move to the next function/procedure/task, which ever comes next + (‘ada-next-procedure’). +‘M-C-a’ + Move to previous function/procedure/task + (‘ada-previous-procedure’). +‘M-x ada-next-package’ + Move to next package. +‘M-x ada-previous-package’ + Move to previous package. +‘C-c C-a’ + Move to matching start of ‘end’ (‘ada-move-to-start’). If point is + at the end of a subprogram, this command jumps to the corresponding + ‘begin’ if the user option ‘ada-move-to-declaration’ is ‘nil’ + (default), otherwise it jumps to the subprogram declaration. +‘C-c C-e’ + Move point to end of current block (‘ada-move-to-end’). +‘C-c o’ + Switch between corresponding spec and body file + (‘ff-find-other-file’). If point is in a subprogram, position + point on the corresponding declaration or body in the other file. +‘C-c c-d’ + Move from any reference to its declaration, for from a declaration + to its body (for procedures, tasks, private and incomplete types). +‘C-c C-r’ + Runs the ‘gnatfind’ command to search for all references to the + identifier surrounding point (‘ada-find-references’). Use ‘C-x `’ + (‘next-error’) to visit each reference (as for compilation errors). + + If the ‘ada-xref-create-ali’ variable is non-‘nil’, Emacs will try to +run GNAT for you whenever cross-reference information is needed, and is +older than the current source file. + + +File: ada-mode.info, Node: Identifier completion, Next: Automatic Smart Indentation, Prev: Moving Through Ada Code, Up: Top + +8 Identifier completion +*********************** + +Emacs and Ada mode provide two general ways for the completion of +identifiers. This is an easy way to type faster: you just have to type +the first few letters of an identifiers, and then loop through all the +possible completions. + + The first method is general for Emacs. It works by parsing all open +files for possible completions. + + For instance, if the words ‘my_identifier’, ‘my_subprogram’ are the +only words starting with ‘my’ in any of the opened files, then you will +have this scenario: + + You type: myM-/ + Emacs inserts: ‘my_identifier’ + If you press M-/ once again, Emacs replaces ‘my_identifier’ with + ‘my_subprogram’. + Pressing M-/ once more will bring you back to ‘my_identifier’. + + This is a very fast way to do completion, and the casing of words +will also be respected. + + The second method (‘C-’) is specific to Ada mode and the GNAT +compiler. Emacs will search the cross-information for possible +completions. + + The main advantage is that this completion is more accurate: only +existing identifier will be suggested. + + On the other hand, this completion is a little bit slower and +requires that you have compiled your file at least once since you +created that identifier. + +‘C-’ + Complete current identifier using cross-reference information. +‘M-/’ + Complete identifier using buffer information (not Ada-specific). + + +File: ada-mode.info, Node: Automatic Smart Indentation, Next: Formatting Parameter Lists, Prev: Identifier completion, Up: Top + +9 Automatic Smart Indentation +***************************** + +Ada mode comes with a full set of rules for automatic indentation. You +can also configure the indentation, via the following variables: + +‘ada-broken-indent’ (default value: 2) + Number of columns to indent the continuation of a broken line. + +‘ada-indent’ (default value: 3) + Number of columns for default indentation. + +‘ada-indent-record-rel-type’ (default value: 3) + Indentation for ‘record’ relative to ‘type’ or ‘use’. + +‘ada-indent-return’ (default value: 0) + Indentation for ‘return’ relative to ‘function’ (if + ‘ada-indent-return’ is greater than 0), or the open parenthesis (if + ‘ada-indent-return’ is negative or 0). Note that in the second + case, when there is no open parenthesis, the indentation is done + relative to ‘function’ with the value of ‘ada-broken-indent’. + +‘ada-label-indent’ (default value: -4) + Number of columns to indent a label. + +‘ada-stmt-end-indent’ (default value: 0) + Number of columns to indent a statement ‘end’ keyword on a separate + line. + +‘ada-when-indent’ (default value: 3) + Indentation for ‘when’ relative to ‘exception’ or ‘case’. + +‘ada-indent-is-separate’ (default value: t) + Non-‘nil’ means indent ‘is separate’ or ‘is abstract’ if on a + single line. + +‘ada-indent-to-open-paren’ (default value: t) + Non-‘nil’ means indent according to the innermost open parenthesis. + +‘ada-indent-after-return’ (default value: t) + Non-‘nil’ means that the current line will also be re-indented + before inserting a newline, when you press . + + Most of the time, the indentation will be automatic, i.e., when you +press , the cursor will move to the correct column on the next +line. + + You can also indent single lines, or the current region, with . + + Another mode of indentation exists that helps you to set up your +indentation scheme. If you press ‘C-c ’, Ada mode will do the +following: + + • Reindent the current line, as would do. + • Temporarily move the cursor to a reference line, i.e., the line + that was used to calculate the current indentation. + • Display in the message window the name of the variable that + provided the offset for the indentation. + + The exact indentation of the current line is the same as the one for +the reference line, plus an offset given by the variable. + +‘’ + Indent the current line or the current region. +‘C-M-\’ + Indent lines in the current region. +‘C-c ’ + Indent the current line and display the name of the variable used + for indentation. + + +File: ada-mode.info, Node: Formatting Parameter Lists, Next: Automatic Casing, Prev: Automatic Smart Indentation, Up: Top + +10 Formatting Parameter Lists +***************************** + +‘C-c C-f’ + Format the parameter list (‘ada-format-paramlist’). + + This aligns the declarations on the colon (‘:’) separating argument +names and argument types, and aligns the ‘in’, ‘out’ and ‘in out’ +keywords. + + +File: ada-mode.info, Node: Automatic Casing, Next: Statement Templates, Prev: Formatting Parameter Lists, Up: Top + +11 Automatic Casing +******************* + +Casing of identifiers, attributes and keywords is automatically +performed while typing when the variable ‘ada-auto-case’ is set. Every +time you press a word separator, the previous word is automatically +cased. + + You can customize the automatic casing differently for keywords, +attributes and identifiers. The relevant variables are the following: +‘ada-case-keyword’, ‘ada-case-attribute’ and ‘ada-case-identifier’. + + All these variables can have one of the following values: + +‘downcase-word’ + The word will be lowercase. For instance ‘My_vARIable’ is + converted to ‘my_variable’. + +‘upcase-word’ + The word will be uppercase. For instance ‘My_vARIable’ is + converted to ‘MY_VARIABLE’. + +‘ada-capitalize-word’ + The first letter and each letter following an underscore (‘_’) are + uppercase, others are lowercase. For instance ‘My_vARIable’ is + converted to ‘My_Variable’. + +‘ada-loose-case-word’ + Characters after an underscore ‘_’ character are uppercase, others + are not modified. For instance ‘My_vARIable’ is converted to + ‘My_VARIable’. + + Ada mode allows you to define exceptions to these rules, in a file +specified by the variable ‘ada-case-exception-file’ (default +‘~/.emacs_case_exceptions’). Each line in this file specifies the +casing of one word or word fragment. Comments may be included, +separated from the word by a space. + + If the word starts with an asterisk (‘*’), it defines the casing as a +word fragment (or “substring”); part of a word between two underscores +or word boundary. + + For example: + + DOD Department of Defense + *IO + GNAT The GNAT compiler from Ada Core Technologies + + The word fragment ‘*IO’ applies to any word containing “_io”; +‘Text_IO’, ‘Hardware_IO’, etc. + + There are two ways to add new items to this file: you can simply edit +it as you would edit any text file. Or you can position point on the +word you want to add, and select menu ‘Ada | Edit | Create Case +Exception’, or press ‘C-c C-y’ (‘ada-create-case-exception’). The word +will automatically be added to the current list of exceptions and to the +file. + + To define a word fragment case exception, select the word fragment, +then select menu ‘Ada | Edit | Create Case Exception Substring’. + + It is sometimes useful to have multiple exception files around (for +instance, one could be the standard Ada acronyms, the second some +company specific exceptions, and the last one some project specific +exceptions). If you set up the variable ‘ada-case-exception-file’ as a +list of files, each of them will be parsed and used in your emacs +session. However, when you save a new exception through the menu, as +described above, the new exception will be added to the first file in +the list. + +‘C-c C-b’ + Adjust case in the whole buffer (‘ada-adjust-case-buffer’). +‘C-c C-y’ + Create a new entry in the exception dictionary, with the word under + the cursor (‘ada-create-case-exception’) +‘C-c C-t’ + Rereads the exception dictionary from the file + ‘ada-case-exception-file’ (‘ada-case-read-exceptions’). + + +File: ada-mode.info, Node: Statement Templates, Next: Comment Handling, Prev: Automatic Casing, Up: Top + +12 Statement Templates +********************** + +Templates are defined for most Ada statements, using the Emacs +“skeleton” package. They can be inserted in the buffer using the +following commands: + +‘C-c t b’ + exception Block (‘ada-exception-block’). +‘C-c t c’ + case (‘ada-case’). +‘C-c t d’ + declare Block (‘ada-declare-block’). +‘C-c t e’ + else (‘ada-else’). +‘C-c t f’ + for Loop (‘ada-for-loop’). +‘C-c t h’ + Header (‘ada-header’). +‘C-c t i’ + if (‘ada-if’). +‘C-c t k’ + package Body (‘ada-package-body’). +‘C-c t l’ + loop (‘ada-loop’). +‘C-c p’ + subprogram body (‘ada-subprogram-body’). +‘C-c t t’ + task Body (‘ada-task-body’). +‘C-c t w’ + while Loop (‘ada-while’). +‘C-c t u’ + use (‘ada-use’). +‘C-c t x’ + exit (‘ada-exit’). +‘C-c t C-a’ + array (‘ada-array’). +‘C-c t C-e’ + elsif (‘ada-elsif’). +‘C-c t C-f’ + function Spec (‘ada-function-spec’). +‘C-c t C-k’ + package Spec (‘ada-package-spec’). +‘C-c t C-p’ + procedure Spec (‘ada-package-spec’. +‘C-c t C-r’ + record (‘ada-record’). +‘C-c t C-s’ + subtype (‘ada-subtype’). +‘C-c t C-t’ + task Spec (‘ada-task-spec’). +‘C-c t C-u’ + with (‘ada-with’). +‘C-c t C-v’ + private (‘ada-private’). +‘C-c t C-w’ + when (‘ada-when’). +‘C-c t C-x’ + exception (‘ada-exception’). +‘C-c t C-y’ + type (‘ada-type’). + + +File: ada-mode.info, Node: Comment Handling, Next: GNU Free Documentation License, Prev: Statement Templates, Up: Top + +13 Comment Handling +******************* + +By default, comment lines get indented like Ada code. There are a few +additional functions to handle comments: + +‘M-;’ + Start a comment in default column. +‘M-j’ + Continue comment on next line. +‘C-c ;’ + Comment the selected region (add ‘--’ at the beginning of lines). +‘C-c :’ + Uncomment the selected region +‘M-q’ + autofill the current comment. + + +File: ada-mode.info, Node: GNU Free Documentation License, Next: Index, Prev: Comment Handling, Up: Top + +Appendix A GNU Free Documentation License +***************************************** + + Version 1.3, 3 November 2008 + + Copyright © 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. + + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + 0. PREAMBLE + + The purpose of this License is to make a manual, textbook, or other + functional and useful document “free” in the sense of freedom: to + assure everyone the effective freedom to copy and redistribute it, + with or without modifying it, either commercially or + noncommercially. Secondarily, this License preserves for the + author and publisher a way to get credit for their work, while not + being considered responsible for modifications made by others. + + This License is a kind of “copyleft”, which means that derivative + works of the document must themselves be free in the same sense. + It complements the GNU General Public License, which is a copyleft + license designed for free software. + + We have designed this License in order to use it for manuals for + free software, because free software needs free documentation: a + free program should come with manuals providing the same freedoms + that the software does. But this License is not limited to + software manuals; it can be used for any textual work, regardless + of subject matter or whether it is published as a printed book. We + recommend this License principally for works whose purpose is + instruction or reference. + + 1. APPLICABILITY AND DEFINITIONS + + This License applies to any manual or other work, in any medium, + that contains a notice placed by the copyright holder saying it can + be distributed under the terms of this License. Such a notice + grants a world-wide, royalty-free license, unlimited in duration, + to use that work under the conditions stated herein. The + “Document”, below, refers to any such manual or work. Any member + of the public is a licensee, and is addressed as “you”. You accept + the license if you copy, modify or distribute the work in a way + requiring permission under copyright law. + + A “Modified Version” of the Document means any work containing the + Document or a portion of it, either copied verbatim, or with + modifications and/or translated into another language. + + A “Secondary Section” is a named appendix or a front-matter section + of the Document that deals exclusively with the relationship of the + publishers or authors of the Document to the Document’s overall + subject (or to related matters) and contains nothing that could + fall directly within that overall subject. (Thus, if the Document + is in part a textbook of mathematics, a Secondary Section may not + explain any mathematics.) The relationship could be a matter of + historical connection with the subject or with related matters, or + of legal, commercial, philosophical, ethical or political position + regarding them. + + The “Invariant Sections” are certain Secondary Sections whose + titles are designated, as being those of Invariant Sections, in the + notice that says that the Document is released under this License. + If a section does not fit the above definition of Secondary then it + is not allowed to be designated as Invariant. The Document may + contain zero Invariant Sections. If the Document does not identify + any Invariant Sections then there are none. + + The “Cover Texts” are certain short passages of text that are + listed, as Front-Cover Texts or Back-Cover Texts, in the notice + that says that the Document is released under this License. A + Front-Cover Text may be at most 5 words, and a Back-Cover Text may + be at most 25 words. + + A “Transparent” copy of the Document means a machine-readable copy, + represented in a format whose specification is available to the + general public, that is suitable for revising the document + straightforwardly with generic text editors or (for images composed + of pixels) generic paint programs or (for drawings) some widely + available drawing editor, and that is suitable for input to text + formatters or for automatic translation to a variety of formats + suitable for input to text formatters. A copy made in an otherwise + Transparent file format whose markup, or absence of markup, has + been arranged to thwart or discourage subsequent modification by + readers is not Transparent. An image format is not Transparent if + used for any substantial amount of text. A copy that is not + “Transparent” is called “Opaque”. + + Examples of suitable formats for Transparent copies include plain + ASCII without markup, Texinfo input format, LaTeX input format, + SGML or XML using a publicly available DTD, and standard-conforming + simple HTML, PostScript or PDF designed for human modification. + Examples of transparent image formats include PNG, XCF and JPG. + Opaque formats include proprietary formats that can be read and + edited only by proprietary word processors, SGML or XML for which + the DTD and/or processing tools are not generally available, and + the machine-generated HTML, PostScript or PDF produced by some word + processors for output purposes only. + + The “Title Page” means, for a printed book, the title page itself, + plus such following pages as are needed to hold, legibly, the + material this License requires to appear in the title page. For + works in formats which do not have any title page as such, “Title + Page” means the text near the most prominent appearance of the + work’s title, preceding the beginning of the body of the text. + + The “publisher” means any person or entity that distributes copies + of the Document to the public. + + A section “Entitled XYZ” means a named subunit of the Document + whose title either is precisely XYZ or contains XYZ in parentheses + following text that translates XYZ in another language. (Here XYZ + stands for a specific section name mentioned below, such as + “Acknowledgements”, “Dedications”, “Endorsements”, or “History”.) + To “Preserve the Title” of such a section when you modify the + Document means that it remains a section “Entitled XYZ” according + to this definition. + + The Document may include Warranty Disclaimers next to the notice + which states that this License applies to the Document. These + Warranty Disclaimers are considered to be included by reference in + this License, but only as regards disclaiming warranties: any other + implication that these Warranty Disclaimers may have is void and + has no effect on the meaning of this License. + + 2. VERBATIM COPYING + + You may copy and distribute the Document in any medium, either + commercially or noncommercially, provided that this License, the + copyright notices, and the license notice saying this License + applies to the Document are reproduced in all copies, and that you + add no other conditions whatsoever to those of this License. You + may not use technical measures to obstruct or control the reading + or further copying of the copies you make or distribute. However, + you may accept compensation in exchange for copies. If you + distribute a large enough number of copies you must also follow the + conditions in section 3. + + You may also lend copies, under the same conditions stated above, + and you may publicly display copies. + + 3. COPYING IN QUANTITY + + If you publish printed copies (or copies in media that commonly + have printed covers) of the Document, numbering more than 100, and + the Document’s license notice requires Cover Texts, you must + enclose the copies in covers that carry, clearly and legibly, all + these Cover Texts: Front-Cover Texts on the front cover, and + Back-Cover Texts on the back cover. Both covers must also clearly + and legibly identify you as the publisher of these copies. The + front cover must present the full title with all words of the title + equally prominent and visible. You may add other material on the + covers in addition. Copying with changes limited to the covers, as + long as they preserve the title of the Document and satisfy these + conditions, can be treated as verbatim copying in other respects. + + If the required texts for either cover are too voluminous to fit + legibly, you should put the first ones listed (as many as fit + reasonably) on the actual cover, and continue the rest onto + adjacent pages. + + If you publish or distribute Opaque copies of the Document + numbering more than 100, you must either include a machine-readable + Transparent copy along with each Opaque copy, or state in or with + each Opaque copy a computer-network location from which the general + network-using public has access to download using public-standard + network protocols a complete Transparent copy of the Document, free + of added material. If you use the latter option, you must take + reasonably prudent steps, when you begin distribution of Opaque + copies in quantity, to ensure that this Transparent copy will + remain thus accessible at the stated location until at least one + year after the last time you distribute an Opaque copy (directly or + through your agents or retailers) of that edition to the public. + + It is requested, but not required, that you contact the authors of + the Document well before redistributing any large number of copies, + to give them a chance to provide you with an updated version of the + Document. + + 4. MODIFICATIONS + + You may copy and distribute a Modified Version of the Document + under the conditions of sections 2 and 3 above, provided that you + release the Modified Version under precisely this License, with the + Modified Version filling the role of the Document, thus licensing + distribution and modification of the Modified Version to whoever + possesses a copy of it. In addition, you must do these things in + the Modified Version: + + A. Use in the Title Page (and on the covers, if any) a title + distinct from that of the Document, and from those of previous + versions (which should, if there were any, be listed in the + History section of the Document). You may use the same title + as a previous version if the original publisher of that + version gives permission. + + B. List on the Title Page, as authors, one or more persons or + entities responsible for authorship of the modifications in + the Modified Version, together with at least five of the + principal authors of the Document (all of its principal + authors, if it has fewer than five), unless they release you + from this requirement. + + C. State on the Title page the name of the publisher of the + Modified Version, as the publisher. + + D. Preserve all the copyright notices of the Document. + + E. Add an appropriate copyright notice for your modifications + adjacent to the other copyright notices. + + F. Include, immediately after the copyright notices, a license + notice giving the public permission to use the Modified + Version under the terms of this License, in the form shown in + the Addendum below. + + G. Preserve in that license notice the full lists of Invariant + Sections and required Cover Texts given in the Document’s + license notice. + + H. Include an unaltered copy of this License. + + I. Preserve the section Entitled “History”, Preserve its Title, + and add to it an item stating at least the title, year, new + authors, and publisher of the Modified Version as given on the + Title Page. If there is no section Entitled “History” in the + Document, create one stating the title, year, authors, and + publisher of the Document as given on its Title Page, then add + an item describing the Modified Version as stated in the + previous sentence. + + J. Preserve the network location, if any, given in the Document + for public access to a Transparent copy of the Document, and + likewise the network locations given in the Document for + previous versions it was based on. These may be placed in the + “History” section. You may omit a network location for a work + that was published at least four years before the Document + itself, or if the original publisher of the version it refers + to gives permission. + + K. For any section Entitled “Acknowledgements” or “Dedications”, + Preserve the Title of the section, and preserve in the section + all the substance and tone of each of the contributor + acknowledgements and/or dedications given therein. + + L. Preserve all the Invariant Sections of the Document, unaltered + in their text and in their titles. Section numbers or the + equivalent are not considered part of the section titles. + + M. Delete any section Entitled “Endorsements”. Such a section + may not be included in the Modified Version. + + N. Do not retitle any existing section to be Entitled + “Endorsements” or to conflict in title with any Invariant + Section. + + O. Preserve any Warranty Disclaimers. + + If the Modified Version includes new front-matter sections or + appendices that qualify as Secondary Sections and contain no + material copied from the Document, you may at your option designate + some or all of these sections as invariant. To do this, add their + titles to the list of Invariant Sections in the Modified Version’s + license notice. These titles must be distinct from any other + section titles. + + You may add a section Entitled “Endorsements”, provided it contains + nothing but endorsements of your Modified Version by various + parties—for example, statements of peer review or that the text has + been approved by an organization as the authoritative definition of + a standard. + + You may add a passage of up to five words as a Front-Cover Text, + and a passage of up to 25 words as a Back-Cover Text, to the end of + the list of Cover Texts in the Modified Version. Only one passage + of Front-Cover Text and one of Back-Cover Text may be added by (or + through arrangements made by) any one entity. If the Document + already includes a cover text for the same cover, previously added + by you or by arrangement made by the same entity you are acting on + behalf of, you may not add another; but you may replace the old + one, on explicit permission from the previous publisher that added + the old one. + + The author(s) and publisher(s) of the Document do not by this + License give permission to use their names for publicity for or to + assert or imply endorsement of any Modified Version. + + 5. COMBINING DOCUMENTS + + You may combine the Document with other documents released under + this License, under the terms defined in section 4 above for + modified versions, provided that you include in the combination all + of the Invariant Sections of all of the original documents, + unmodified, and list them all as Invariant Sections of your + combined work in its license notice, and that you preserve all + their Warranty Disclaimers. + + The combined work need only contain one copy of this License, and + multiple identical Invariant Sections may be replaced with a single + copy. If there are multiple Invariant Sections with the same name + but different contents, make the title of each such section unique + by adding at the end of it, in parentheses, the name of the + original author or publisher of that section if known, or else a + unique number. Make the same adjustment to the section titles in + the list of Invariant Sections in the license notice of the + combined work. + + In the combination, you must combine any sections Entitled + “History” in the various original documents, forming one section + Entitled “History”; likewise combine any sections Entitled + “Acknowledgements”, and any sections Entitled “Dedications”. You + must delete all sections Entitled “Endorsements.” + + 6. COLLECTIONS OF DOCUMENTS + + You may make a collection consisting of the Document and other + documents released under this License, and replace the individual + copies of this License in the various documents with a single copy + that is included in the collection, provided that you follow the + rules of this License for verbatim copying of each of the documents + in all other respects. + + You may extract a single document from such a collection, and + distribute it individually under this License, provided you insert + a copy of this License into the extracted document, and follow this + License in all other respects regarding verbatim copying of that + document. + + 7. AGGREGATION WITH INDEPENDENT WORKS + + A compilation of the Document or its derivatives with other + separate and independent documents or works, in or on a volume of a + storage or distribution medium, is called an “aggregate” if the + copyright resulting from the compilation is not used to limit the + legal rights of the compilation’s users beyond what the individual + works permit. When the Document is included in an aggregate, this + License does not apply to the other works in the aggregate which + are not themselves derivative works of the Document. + + If the Cover Text requirement of section 3 is applicable to these + copies of the Document, then if the Document is less than one half + of the entire aggregate, the Document’s Cover Texts may be placed + on covers that bracket the Document within the aggregate, or the + electronic equivalent of covers if the Document is in electronic + form. Otherwise they must appear on printed covers that bracket + the whole aggregate. + + 8. TRANSLATION + + Translation is considered a kind of modification, so you may + distribute translations of the Document under the terms of section + 4. Replacing Invariant Sections with translations requires special + permission from their copyright holders, but you may include + translations of some or all Invariant Sections in addition to the + original versions of these Invariant Sections. You may include a + translation of this License, and all the license notices in the + Document, and any Warranty Disclaimers, provided that you also + include the original English version of this License and the + original versions of those notices and disclaimers. In case of a + disagreement between the translation and the original version of + this License or a notice or disclaimer, the original version will + prevail. + + If a section in the Document is Entitled “Acknowledgements”, + “Dedications”, or “History”, the requirement (section 4) to + Preserve its Title (section 1) will typically require changing the + actual title. + + 9. TERMINATION + + You may not copy, modify, sublicense, or distribute the Document + except as expressly provided under this License. Any attempt + otherwise to copy, modify, sublicense, or distribute it is void, + and will automatically terminate your rights under this License. + + However, if you cease all violation of this License, then your + license from a particular copyright holder is reinstated (a) + provisionally, unless and until the copyright holder explicitly and + finally terminates your license, and (b) permanently, if the + copyright holder fails to notify you of the violation by some + reasonable means prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is + reinstated permanently if the copyright holder notifies you of the + violation by some reasonable means, this is the first time you have + received notice of violation of this License (for any work) from + that copyright holder, and you cure the violation prior to 30 days + after your receipt of the notice. + + Termination of your rights under this section does not terminate + the licenses of parties who have received copies or rights from you + under this License. If your rights have been terminated and not + permanently reinstated, receipt of a copy of some or all of the + same material does not give you any rights to use it. + + 10. FUTURE REVISIONS OF THIS LICENSE + + The Free Software Foundation may publish new, revised versions of + the GNU Free Documentation License from time to time. Such new + versions will be similar in spirit to the present version, but may + differ in detail to address new problems or concerns. See + . + + Each version of the License is given a distinguishing version + number. If the Document specifies that a particular numbered + version of this License “or any later version” applies to it, you + have the option of following the terms and conditions either of + that specified version or of any later version that has been + published (not as a draft) by the Free Software Foundation. If the + Document does not specify a version number of this License, you may + choose any version ever published (not as a draft) by the Free + Software Foundation. If the Document specifies that a proxy can + decide which future versions of this License can be used, that + proxy’s public statement of acceptance of a version permanently + authorizes you to choose that version for the Document. + + 11. RELICENSING + + “Massive Multiauthor Collaboration Site” (or “MMC Site”) means any + World Wide Web server that publishes copyrightable works and also + provides prominent facilities for anybody to edit those works. A + public wiki that anybody can edit is an example of such a server. + A “Massive Multiauthor Collaboration” (or “MMC”) contained in the + site means any set of copyrightable works thus published on the MMC + site. + + “CC-BY-SA” means the Creative Commons Attribution-Share Alike 3.0 + license published by Creative Commons Corporation, a not-for-profit + corporation with a principal place of business in San Francisco, + California, as well as future copyleft versions of that license + published by that same organization. + + “Incorporate” means to publish or republish a Document, in whole or + in part, as part of another Document. + + An MMC is “eligible for relicensing” if it is licensed under this + License, and if all works that were first published under this + License somewhere other than this MMC, and subsequently + incorporated in whole or in part into the MMC, (1) had no cover + texts or invariant sections, and (2) were thus incorporated prior + to November 1, 2008. + + The operator of an MMC Site may republish an MMC contained in the + site under CC-BY-SA on the same site at any time before August 1, + 2009, provided the MMC is eligible for relicensing. + +ADDENDUM: How to use this License for your documents +==================================================== + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and license +notices just after the title page: + + Copyright (C) YEAR YOUR NAME. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.3 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. + + If you have Invariant Sections, Front-Cover Texts and Back-Cover +Texts, replace the “with...Texts.” line with this: + + with the Invariant Sections being LIST THEIR TITLES, with + the Front-Cover Texts being LIST, and with the Back-Cover Texts + being LIST. + + If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + + If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of free +software license, such as the GNU General Public License, to permit +their use in free software. + + +File: ada-mode.info, Node: Index, Prev: GNU Free Documentation License, Up: Top + +Index +***** + +[index] +* Menu: + +* ada-adjust-case-buffer: Automatic Casing. (line 74) +* ada-array: Statement Templates. (line 39) +* ada-case: Statement Templates. (line 13) +* ada-case-read-exceptions: Automatic Casing. (line 79) +* ada-complete-identifier: Identifier completion. + (line 39) +* ada-create-case-exception: Automatic Casing. (line 54) +* ada-declare-block: Statement Templates. (line 15) +* ada-else: Statement Templates. (line 17) +* ada-elsif: Statement Templates. (line 41) +* ada-exception: Statement Templates. (line 61) +* ada-exception-block: Statement Templates. (line 11) +* ada-exit: Statement Templates. (line 37) +* ada-find-references: Moving Through Ada Code. + (line 37) +* ada-for-loop: Statement Templates. (line 19) +* ada-format-paramlist: Formatting Parameter Lists. + (line 7) +* ada-function-spec: Statement Templates. (line 43) +* ada-goto-declaration: Moving Through Ada Code. + (line 34) +* ada-header: Statement Templates. (line 21) +* ada-if: Statement Templates. (line 23) +* ada-loop: Statement Templates. (line 27) +* ada-move-to-end: Moving Through Ada Code. + (line 28) +* ada-move-to-start: Moving Through Ada Code. + (line 23) +* ada-next-package: Moving Through Ada Code. + (line 19) +* ada-next-procedure: Moving Through Ada Code. + (line 13) +* ada-package-body: Statement Templates. (line 25) +* ada-package-spec: Statement Templates. (line 45) +* ada-previous-package: Moving Through Ada Code. + (line 21) +* ada-previous-procedure: Moving Through Ada Code. + (line 16) +* ada-private: Statement Templates. (line 57) +* ada-procedure-spec: Statement Templates. (line 47) +* ada-record: Statement Templates. (line 49) +* ada-subprogram-body: Statement Templates. (line 29) +* ada-subtype: Statement Templates. (line 51) +* ada-task-body: Statement Templates. (line 31) +* ada-task-spec: Statement Templates. (line 53) +* ada-type: Statement Templates. (line 63) +* ada-use: Statement Templates. (line 35) +* ada-when: Statement Templates. (line 59) +* ada-while: Statement Templates. (line 33) +* ada-with: Statement Templates. (line 55) + + + +Tag Table: +Node: Top862 +Node: Overview2536 +Node: Installation3858 +Node: Customization5019 +Node: Non-standard file names5943 +Node: Other compiler7474 +Node: Other customization7978 +Node: Compiling Executing8652 +Node: Compile commands9328 +Node: Compiler errors12177 +Node: Project files13082 +Node: Project File Overview13795 +Node: GUI Editor16150 +Node: Project file variables16642 +Node: Compiling Examples23982 +Node: No project files24780 +Node: Set compiler options29651 +Node: Set source search path31696 +Node: Use GNAT project file34044 +Node: Use multiple GNAT project files36288 +Node: Moving Through Ada Code38239 +Node: Identifier completion40280 +Node: Automatic Smart Indentation41884 +Node: Formatting Parameter Lists44754 +Node: Automatic Casing45184 +Node: Statement Templates48588 +Node: Comment Handling50251 +Node: GNU Free Documentation License50806 +Node: Index76164 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/old-ada/doc/ada-mode.pdf b/old-ada/doc/ada-mode.pdf new file mode 100644 index 0000000..c3f3839 Binary files /dev/null and b/old-ada/doc/ada-mode.pdf differ diff --git a/old-ada/doc/ada-mode.texi b/old-ada/doc/ada-mode.texi new file mode 100644 index 0000000..1ac90cd --- /dev/null +++ b/old-ada/doc/ada-mode.texi @@ -0,0 +1,1526 @@ +\input texinfo @c -*-texinfo-*- +@setfilename ../../info/ada-mode.info +@settitle Ada Mode +@include docstyle.texi + +@copying +Copyright @copyright{} 1999--2019 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover Texts being ``A GNU Manual'', +and with the Back-Cover Texts as in (a) below. A copy of the license +is included in the section entitled ``GNU Free Documentation License''. + +(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and +modify this GNU manual.'' +@end quotation +@end copying + +@dircategory Emacs editing modes +@direntry +* Ada mode: (ada-mode). Emacs mode for editing and compiling Ada code. +@end direntry + +@titlepage +@sp 10 +@title Ada Mode +@sp 2 +@subtitle An Emacs major mode for programming in Ada +@subtitle Ada Mode Version 4.00 +@sp 2 +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@contents + +@node Top +@top Ada Mode + +@ifnottex +@insertcopying +@end ifnottex + +@menu +* Overview:: +* Installation:: Installing Ada mode on your system +* Customization:: Setting up Ada mode to your taste +* Compiling Executing:: Working with your application within Emacs +* Project files:: Describing the organization of your project +* Compiling Examples:: A small tutorial +* Moving Through Ada Code:: Moving easily through Ada sources +* Identifier completion:: Finishing words automatically +* Automatic Smart Indentation:: Indenting your code automatically as you type +* Formatting Parameter Lists:: Formatting subprograms' parameter lists + automatically +* Automatic Casing:: Adjusting the case of words automatically +* Statement Templates:: Inserting code templates +* Comment Handling:: Reformatting comments easily +* GNU Free Documentation License:: The license for this documentation. +* Index:: +@end menu + + +@node Overview +@chapter Overview + +The Emacs mode for programming in Ada helps the user in understanding +existing code and facilitates writing new code. + +When the GNU Ada compiler GNAT is used, the cross-reference +information output by the compiler is used to provide powerful code +navigation (jump to definition, find all uses, etc.). + +When you open a file with a file extension of @file{.ads} or +@file{.adb}, Emacs will automatically load and activate Ada mode. + +Ada mode works without any customization, if you are using the GNAT +compiler (@url{https://libre2.adacore.com/}) and the GNAT default +naming convention. + +You must customize a few things if you are using a different compiler +or file naming convention; @xref{Other compiler}, @xref{Non-standard +file names}. + +In addition, you may want to customize the indentation, +capitalization, and other things; @xref{Other customization}. + +Finally, for large Ada projects, you will want to set up an Emacs +Ada mode project file for each project; @xref{Project files}. Note +that these are different from the GNAT project files used by gnatmake +and other GNAT commands. + +See the Emacs info manual, section 'Running Debuggers Under Emacs', +for general information on debugging. + +@node Installation +@chapter Installation + +Ada mode is part of the standard Emacs distribution; if you use that, +no files need to be installed. + +Ada mode is also available as a separate distribution, from the Emacs +Ada mode website +@uref{http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html}. The +separate distribution may be more recent. + +For installing the separate distribution, see the @file{README} file +in the distribution. + +To see what version of Ada mode you have installed, do @kbd{M-x +ada-mode-version}. + +The following files are provided with the Ada mode distribution: + +@itemize @bullet + +@item +@file{ada-mode.el}: The main file for Ada mode, providing indentation, +formatting of parameter lists, moving through code, comment handling +and automatic casing. + +@item +@file{ada-prj.el}: GUI editing of Ada mode project files, using Emacs +widgets. + +@item +@file{ada-stmt.el}: Ada statement templates. + +@item +@file{ada-xref.el}: GNAT cross-references, completion of identifiers, +and compilation. Also provides project files (which are not +GNAT-specific). + +@end itemize + +@node Customization +@chapter Customizing Ada mode + +Here we assume you are familiar with setting variables in Emacs, +either thru 'customize' or in elisp (in your @file{.emacs} file). For +a basic introduction to customize, elisp, and Emacs in general, see +the tutorial in +@iftex +@cite{The GNU Emacs Manual}. +@end iftex +@ifhtml +@cite{The GNU Emacs Manual}. +@end ifhtml +@ifinfo +@ref{Top, , The GNU Emacs Manual, emacs, The GNU Emacs Manual}. +@end ifinfo + +These global Emacs settings are strongly recommended (put them in your +.emacs): + +@example +(global-font-lock-mode t) +(transient-mark-mode t) +@end example + +@samp{(global-font-lock-mode t)} turns on syntax +highlighting for all buffers (it is off by default because it may be +too slow for some machines). + +@samp{(transient-mark-mode t)} highlights selected text. + +See the Emacs help for each of these variables for more information. + +@menu +* Non-standard file names:: +* Other compiler:: +* Other customization:: +@end menu + +@node Non-standard file names +@section Non-standard file names + +By default, Ada mode is configured to use the GNAT file naming +convention, where file names are a simple modification of the Ada +names, and the extension for specs and bodies are +@samp{.ads} and @samp{.adb}, respectively. + +Ada mode uses the file extensions to allow moving from a package body +to the corresponding spec and back. + +Ada mode supports a list of alternative file extensions for specs and bodies. + +For instance, if your spec and bodies files are called +@file{@var{unit}_s.ada} and @file{@var{unit}_b.ada}, respectively, you +can add the following to your @file{.emacs} file: + +@example +(ada-add-extensions "_s.ada" "_b.ada") +@end example + +You can define additional extensions: + +@example +(ada-add-extensions ".ads" "_b.ada") +(ada-add-extensions ".ads" ".body") +@end example + +This means that whenever Ada mode looks for the body for a file +whose extension is @file{.ads}, it will take the first available file +that ends with either @file{.adb}, @file{_b.ada} or +@file{.body}. + +Similarly, if Ada mode is looking for a spec, it will look for +@file{.ads} or @file{_s.ada}. + +If the filename is not derived from the Ada name following the GNAT +convention, things are a little more complicated. You then need to +rewrite the function @code{ada-make-filename-from-adaname}. Doing that +is beyond the scope of this manual; see the current definitions in +@file{ada-mode.el} and @file{ada-xref.el} for examples. + +@node Other compiler +@section Other compiler + +By default, Ada mode is configured to use the GNU Ada compiler GNAT. + +To use a different Ada compiler, you must specify the command lines +used to run that compiler, either in lisp variables or in Emacs +Ada mode project files. See @ref{Project file variables} for the list +of project variables, and the corresponding lisp variables. + +@node Other customization +@section Other customization + +All user-settable Ada mode variables can be set via the menu +@samp{Ada | Customize}. Click on the @samp{Help} button there for help +on using customize. + +To modify a specific variable, you can directly call the function +@code{customize-variable}; just type @kbd{M-x customize-variable +@key{RET} @var{variable-name} @key{RET}}). + +Alternately, you can specify variable settings in the Emacs +configuration file, @file{.emacs}. This file is coded in Emacs lisp, +and the syntax to set a variable is the following: +@example +(setq variable-name value) +@end example + +@node Compiling Executing +@chapter Compiling Executing + +Ada projects can be compiled, linked, and executed using commands on +the Ada menu. All of these commands can be customized via a project +file (@pxref{Project files}), but the defaults are sufficient for using +the GNAT compiler for simple projects (single files, or several files +in a single directory). + +Even when no project file is used, the GUI project editor (menu +@samp{Ada | Project | Edit}) shows the settings of the various project +file variables referenced here. + +@menu +* Compile commands:: +* Compiler errors:: +@end menu + +@node Compile commands +@section Compile commands + +Here are the commands for building and using an Ada project, as +listed in the Ada menu. + +In multi-file projects, there must be one file that is the main +program. That is given by the @code{main} project file variable; +it defaults to the current file if not yet set, but is also set by the +``set main and build'' command. + +@table @code + +@item Check file +Compiles the current file in syntax check mode, by running +@code{check_cmd} defined in the current project file. This typically +runs faster than full compile mode, speeding up finding and fixing +compilation errors. + +This sets @code{main} only if it has not been set yet. + +@item Compile file +Compiles the current file, by running @code{comp_cmd} from the current +project file. + +This does not set @code{main}. + +@item Set main and Build +Sets @code{main} to the current file, then executes the Build +command. + +@item Show main +Display @code{main} in the message buffer. + +@item Build +Compiles all obsolete units of the current @code{main}, and links +@code{main}, by running @code{make_cmd} from the current project. + +This sets @code{main} only if it has not been set yet. + +@item Run +Executes the main program in a shell, displayed in a separate Emacs +buffer. This runs @code{run_cmd} from the current project. The +execution buffer allows for interactive input/output. + +To modify the run command, in particular to provide or change the +command line arguments, type @kbd{C-u} before invoking the command. + +This command is not available for a cross-compilation toolchain. + +@end table +It is important when using these commands to understand how +@code{main} is used and changed. + +Build runs 'gnatmake' on the main unit. During a typical edit/compile +session, this is the only command you need to invoke, which is why it +is bound to @kbd{C-c C-c}. It will compile all files needed by the +main unit, and display compilation errors in any of them. + +Note that Build can be invoked from any Ada buffer; typically you will +be fixing errors in files other than the main, but you don't have to +switch back to the main to invoke the compiler again. + +Novices and students typically work on single-file Ada projects. In +this case, @kbd{C-c C-m} will normally be the only command needed; it +will build the current file, rather than the last-built main. + +There are three ways to change @code{main}: + +@enumerate +@item +Invoke @samp{Ada | Set main and Build}, which sets @code{main} to +the current file. + +@item +Invoke @samp{Ada | Project | Edit}, edit @code{main} and +@code{main}, and click @samp{[save]} + +@item +Invoke @samp{Ada | Project | Load}, and load a project file that specifies @code{main} + +@end enumerate + +@node Compiler errors +@section Compiler errors + +The @code{Check file}, @code{Compile file}, and @code{Build} commands +all place compilation errors in a separate buffer named +@file{*compilation*}. + +Each line in this buffer will become active: you can simply click on +it with the middle button of the mouse, or move point to it and press +@key{RET}. Emacs will then display the relevant source file and put +point on the line and column where the error was found. + +You can also press the @kbd{C-x `} key (@code{next-error}), and Emacs +will jump to the first error. If you press that key again, it will +move you to the second error, and so on. + +Some error messages might also include references to other files. These +references are also clickable in the same way, or put point after the +line number and press @key{RET}. + +@node Project files +@chapter Project files + +An Emacs Ada mode project file specifies what directories hold sources +for your project, and allows you to customize the compilation commands +and other things on a per-project basis. + +Note that Ada mode project files @file{*.adp} are different than GNAT +compiler project files @file{*.gpr}. However, Emacs Ada mode can use a +GNAT project file to specify the project directories. If no +other customization is needed, a GNAT project file can be used without +an Emacs Ada mode project file. + +@menu +* Project File Overview:: +* GUI Editor:: +* Project file variables:: +@end menu + +@node Project File Overview +@section Project File Overview + +Project files have a simple syntax; they may be edited directly. Each +line specifies a project variable name and its value, separated by ``='': +@example +src_dir=/Projects/my_project/src_1 +src_dir=/Projects/my_project/src_2 +@end example + +Some variables (like @code{src_dir}) are lists; multiple occurrences +are concatenated. + +There must be no space between the variable name and ``='', and no +trailing spaces. + +Alternately, a GUI editor for project files is available (@pxref{GUI +Editor}). It uses Emacs widgets, similar to Emacs customize. + +The GUI editor also provides a convenient way to view current project +settings, if they have been modified using menu commands rather than +by editing the project file. + +After the first Ada mode build command is invoked, there is always a +current project file, given by the lisp variable +@code{ada-prj-default-project-file}. Currently, the only way to show +the current project file is to invoke the GUI editor. + +To find the project file the first time, Ada mode uses the following +search algorithm: + +@itemize @bullet +@item +If @code{ada-prj-default-project-file} is set, use that. + +@item +Otherwise, search for a file in the current directory with +the same base name as the Ada file, but extension given by +@code{ada-prj-file-extension} (default @code{".adp"}). + +@item +If not found, search for @file{*.adp} in the current directory; if +several are found, prompt the user to select one. + +@item +If none are found, use @file{default.adp} in the current directory (even +if it does not exist). + +@end itemize + +This algorithm always sets @code{ada-prj-default-project-file}, even +when the file does not actually exist. + +To change the project file before or after the first one is found, +invoke @samp{Ada | Project | Load ...}. + +Or, in lisp, evaluate @code{(ada-set-default-project-file "/path/file.adp")}. +This sets @code{ada-prj-default-project-file}, and reads the project file. + +You can also specify a GNAT project file to @samp{Ada | Project | Load +...} or @code{ada-set-default-project-file}. Emacs Ada mode checks the +file extension; if it is @code{.gpr}, the file is treated as a GNAT +project file. Any other extension is treated as an Emacs Ada mode +project file. + +@node GUI Editor +@section GUI Editor + +The project file editor is invoked with the menu @samp{Ada | Projects +| Edit}. + +Once in the buffer for editing the project file, you can save your +modification using the @samp{[save]} button at the bottom of the +buffer, or the @kbd{C-x C-s} binding. To cancel your modifications, +kill the buffer or click on the @samp{[cancel]} button. + +@node Project file variables +@section Project file variables + +The following variables can be defined in a project file; some can +also be defined in lisp variables. + +To set a project variable that is a list, specify each element of the +list on a separate line in the project file. + +Any project variable can be referenced in other project variables, +using a shell-like notation. For instance, if the variable +@code{comp_cmd} contains @code{$@{comp_opt@}}, the value of the +@code{comp_opt} variable will be substituted when @code{comp_cmd} is +used. + +In addition, process environment variables can be referenced using the +same syntax, or the normal @code{$var} syntax. + +Most project variables have defaults that can be changed by setting +lisp variables; the table below identifies the lisp variable for each +project variable. Lisp variables corresponding to project variables +that are lists are lisp lists. + +In general, project variables are evaluated when referenced in +Emacs Ada mode commands. Relative file paths are expanded to +absolute relative to @code{$@{build_dir@}}. + +Here is the list of variables. In the default values, the current +directory @code{"."} is the project file directory. + +@table @asis +@c defined in ada-default-prj-properties; alphabetical order + +@item @code{ada_project_path_sep} [default: @code{":" or ";"}] +Path separator for @code{ADA_PROJECT_PATH}. It defaults to the correct +value for a native implementation of GNAT for the current operating +system. The user must override this when using Windows native GNAT +with Cygwin Emacs, and perhaps in other cases. + +Lisp variable: @code{ada-prj-ada-project-path-sep}. + +@item @code{ada_project_path} [default: @code{""}] +A list of directories to search for GNAT project files. + +If set, the @code{ADA_PROJECT_PATH} process environment variable is +set to this value in the Emacs process when the Emacs Ada mode project +is selected via menu @samp{Ada | Project | Load}. + +For @code{ada_project_path}, relative file paths are expanded to +absolute when the Emacs Ada project file is read, rather than when the +project file is selected. + +For example if the project file is in the directory +@file{/home/myproject}, the environment variable @code{GDS_ROOT} is +set to @code{/home/shared}, and the project file contains: +@example +ada_project_path_sep=: +ada_project_path=$GDS_ROOT/makerules +ada_project_path=../opentoken +@end example +then as a result the environment variable @code{ADA_PROJECT_PATH} will +be set to @code{"/home/shared/makerules:/home/opentoken/"}. + +The default value is not the current value of this environment +variable, because that will typically have been set by another +project, and will therefore be incorrect for this project. + +If you have the environment variable set correctly for all of your +projects, you do not need to set this project variable. + +@item @code{bind_opt} [default: @code{""}] +Holds user binder options; used in the default build commands. + +Lisp variable: @code{ada-prj-default-bind-opt}. + +@item @code{build_dir} [default: @code{"."}] +The compile commands will be issued in this directory. + +@item @code{casing} [default: @code{("~/.emacs_case_exceptions")}] +List of files containing casing exceptions. See the help on +@code{ada-case-exception-file} for more info. +@c FIXME: section on case exceptions + +Lisp variable: @code{ada-case-exception-file}. + +@item @code{check_cmd} [default: @code{"$@{cross_prefix@}gnatmake -u -c -gnatc $@{gnatmake_opt@} $@{full_current@} -cargs $@{comp_opt@}"}] +Command used to syntax check a single file. +The name of the file is substituted for @code{full_current}. + +Lisp variable: @code{ada-prj-default-check-cmd} + +@item @code{comp_cmd} [default: @code{"$@{cross_prefix@}gnatmake -u -c $@{gnatmake_opt@} $@{full_current@} -cargs $@{comp_opt@}"}] +Command used to compile a single file. +The name of the file is substituted for @code{full_current}. + +Lisp variable: @code{ada-prj-default-comp-cmd}. + +@item @code{comp_opt} [default: @code{"-gnatq -gnatQ"}] +Holds user compiler options; used in the default compile commands. The +default value tells gnatmake to generate library files for +cross-referencing even when there are errors. + +If source code for the project is in multiple directories, the +appropriate compiler options must be added here. @ref{Set source +search path} for examples of this. Alternately, GNAT project files may +be used; @ref{Use GNAT project file}. + +Lisp variable: @code{ada-prj-default-comp-opt}. + +@item @code{cross_prefix} [default: @code{""}] +Name of target machine in a cross-compilation environment. Used in +default compile and build commands. + +@item @code{debug_cmd} [default: @code{"$@{cross_prefix@}gdb $@{main@}"}] +Command used to debug the application + +Lisp variable: @code{ada-prj-default-debugger}. + +@item @code{debug_post_cmd} [default: @code{""}] +Command executed after @code{debug_cmd}. + +@item @code{debug_pre_cmd} [default: @code{"cd $@{build_dir@}"}] +Command executed before @code{debug_cmd}. + +@item @code{gnatfind_opt} [default: @code{"-rf"}] +Holds user gnatfind options; used in the default find commands. + +Lisp variable: @code{ada-prj-gnatfind-switches}. + +@item @code{gnatmake_opt} [default: @code{"-g"}] +Holds user gnatmake options; used in the default build commands. + +Lisp variable: @code{ada-prj-default-gnatmake-opt}. + +@item @code{gpr_file} [default: @code{""}] +Specify GNAT project file. + +If set, the source and object directories specified in the GNAT +project file are appended to @code{src_dir} and @code{obj_dir}. This +allows specifying Ada source directories with a GNAT project file, and +other source directories with the Emacs project file. + +In addition, @code{-P@{gpr_file@}} is added to the project variable +@code{gnatmake_opt} whenever it is referenced. With the default +project variables, this passes the project file to all gnatmake +commands. + +Lisp variable: @code{ada-prj-default-gpr-file}. + +@c FIXME: add gnatstub-opts + +@item @code{link_opt} [default: @code{""}] +Holds user linker options; used in the default build commands. + +Lisp variable: @code{ada-prj-default-link-opt}. + +@item @code{main} [default: current file] +Specifies the name of the executable file for the project; used in the +default build commands. + +@item @code{make_cmd} [default: @code{"$@{cross_prefix@}gnatmake -o $@{main@} $@{main@} $@{gnatmake_opt@} -cargs $@{comp_opt@} -bargs $@{bind_opt@} -largs $@{link_opt@}"}] +Command used to build the application. + +Lisp variable: @code{ada-prj-default-make-cmd}. + +@item @code{obj_dir} [default: @code{"."}] +A list of directories to search for library files. Ada mode searches +this list for the @samp{.ali} files generated by GNAT that contain +cross-reference information. + +The compiler commands must place the @samp{.ali} files in one of these +directories; the default commands do that. + +@item @code{remote_machine} [default: @code{""}] +Name of the machine to log into before issuing the compile and build +commands. If this variable is empty, the command will be run on the +local machine. + +@item @code{run_cmd} [default: @code{"./$@{main@}"}] +Command used to run the application. + +@item @code{src_dir} [default: @code{"."}] +A list of directories to search for source files, both for compile +commands and source navigation. + +@end table + +@node Compiling Examples +@chapter Compiling Examples + +We present several small projects, and walk thru the process of +compiling, linking, and running them. + +The first example illustrates more Ada mode features than the others; +you should work thru that example before doing the others. + +All of these examples assume you are using GNAT. + +The source for these examples is available on the Emacs Ada mode +website mentioned in @xref{Installation}. + +@menu +* No project files:: Just menus +* Set compiler options:: A basic Ada mode project file +* Set source search path:: Source in multiple directories +* Use GNAT project file:: +* Use multiple GNAT project files:: +@end menu + +@node No project files +@section No project files +This example uses no project files. + +First, create a directory @file{Example_1}, containing: + +@file{hello.adb}: + +@example +with Ada.Text_IO; +procedure Hello +is begin + Put_Line("Hello from hello.adb"); +end Hello; +@end example + +Yes, this is missing ``use Ada.Text_IO;'' - we want to demonstrate +compiler error handling. + +@file{hello_2.adb}: + +@example +with Hello_Pkg; +procedure Hello_2 +is begin + Hello_Pkg.Say_Hello; +end Hello_2; +@end example + +This file has no errors. + +@file{hello_pkg.ads}: + +@example +package Hello_Pkg is + procedure Say_Hello; +end Hello_Pkg; +@end example + +This file has no errors. + +@file{hello_pkg.adb}: + +@example +with Ada.Text_IO; +package Hello_Pkg is + procedure Say_Hello + is begin + Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); + end Say_Hello; +end Hello_Pkg; +@end example + +Yes, this is missing the keyword @code{body}; another compiler error +example. + +In buffer @file{hello.adb}, invoke @samp{Ada | Check file}. You should +get a @file{*compilation*} buffer containing something like (the +directory paths will be different): + +@smallexample +cd c:/Examples/Example_1/ +gnatmake -u -c -gnatc -g c:/Examples/Example_1/hello.adb -cargs -gnatq -gnatQ +gcc -c -Ic:/Examples/Example_1/ -gnatc -g -gnatq -gnatQ -I- c:/Examples/Example_1/hello.adb +hello.adb:4:04: "Put_Line" is not visible +hello.adb:4:04: non-visible declaration at a-textio.ads:264 +hello.adb:4:04: non-visible declaration at a-textio.ads:260 +gnatmake: "c:/Examples/Example_1/hello.adb" compilation error +@end smallexample + +If you have enabled font-lock, the lines with actual errors (starting +with @file{hello.adb}) are highlighted, with the file name in red. + +Now type @kbd{C-x `} (on a PC keyboard, @key{`} is next to @key{1}). +Or you can click the middle mouse button on the first error line. The +compilation buffer scrolls to put the first error on the top line, and +point is put at the place of the error in the @file{hello.adb} buffer. + +To fix the error, change the line to be + +@example + Ada.Text_IO.Put_Line ("hello from hello.adb"); +@end example + +Now invoke @samp{Ada | Show main}; this displays @samp{Ada mode main: hello}. + +Now (in buffer @file{hello.adb}), invoke @samp{Ada | Build}. You are +prompted to save the file (if you haven't already). Then the +compilation buffer is displayed again, containing: + +@example +cd c:/Examples/Example_1/ +gnatmake -o hello hello -g -cargs -gnatq -gnatQ -bargs -largs +gcc -c -g -gnatq -gnatQ hello.adb +gnatbind -x hello.ali +gnatlink hello.ali -o hello.exe -g +@end example + +The compilation has succeeded without errors; @file{hello.exe} now +exists in the same directory as @file{hello.adb}. + +Now invoke @samp{Ada | Run}. A @file{*run*} buffer is displayed, +containing + +@example +Hello from hello.adb + +Process run finished +@end example + +That completes the first part of this example. + +Now we will compile a multi-file project. Open the file +@file{hello_2.adb}, and invoke @samp{Ada | Set main and Build}. This +finds an error in @file{hello_pkg.adb}: + +@example +cd c:/Examples/Example_1/ +gnatmake -o hello_2 hello_2 -g -cargs -gnatq -gnatQ -bargs -largs +gcc -c -g -gnatq -gnatQ hello_pkg.adb +hello_pkg.adb:2:08: keyword "body" expected here [see file name] +gnatmake: "hello_pkg.adb" compilation error +@end example + +This demonstrates that gnatmake finds the files needed by the main +program. However, it cannot find files in a different directory, +unless you use an Emacs Ada mode project file to specify the other directories; +@xref{Set source search path}, or a GNAT project file; @ref{Use GNAT +project file}. + +Invoke @samp{Ada | Show main}; this displays @file{Ada mode main: hello_2}. + +Move to the error with @kbd{C-x `}, and fix the error by adding @code{body}: + +@example +package body Hello_Pkg is +@end example + +Now, while still in @file{hello_pkg.adb}, invoke @samp{Ada | Build}. +gnatmake successfully builds @file{hello_2}. This demonstrates that +Emacs has remembered the main file, in the project variable +@code{main}, and used it for the Build command. + +Finally, again while in @file{hello_pkg.adb}, invoke @samp{Ada | Run}. +The @file{*run*} buffer displays @code{Hello from hello_pkg.adb}. + +One final point. If you switch back to buffer @file{hello.adb}, and +invoke @samp{Ada | Run}, @file{hello_2.exe} will be run. That is +because @code{main} is still set to @code{hello_2}, as you can +see when you invoke @samp{Ada | Project | Edit}. + +There are three ways to change @code{main}: + +@enumerate +@item +Invoke @samp{Ada | Set main and Build}, which sets @code{main} to +the current file. + +@item +Invoke @samp{Ada | Project | Edit}, edit @code{main}, and click @samp{[save]} + +@item +Invoke @samp{Ada | Project | Load}, and load a project file that specifies @code{main} + +@end enumerate + +@node Set compiler options +@section Set compiler options + +This example illustrates using an Emacs Ada mode project file to set a +compiler option. + +If you have files from @file{Example_1} open in Emacs, you should +close them so you don't get confused. Use menu @samp{File | Close +(current buffer)}. + +In directory @file{Example_2}, create these files: + +@file{hello.adb}: + +@example +with Ada.Text_IO; +procedure Hello +is begin + Put_Line("Hello from hello.adb"); +end Hello; +@end example + +This is the same as @file{hello.adb} from @file{Example_1}. It has two +errors; missing ``use Ada.Text_IO;'', and no space between +@code{Put_Line} and its argument list. + +@file{hello.adp}: + +@example +comp_opt=-gnatyt +@end example + +This tells the GNAT compiler to check for token spacing; in +particular, there must be a space preceding a parenthesis. + +In buffer @file{hello.adb}, invoke @samp{Ada | Project | Load...}, and +select @file{Example_2/hello.adp}. + +Then, again in buffer @file{hello.adb}, invoke @samp{Ada | Set main and +Build}. You should get a @file{*compilation*} buffer containing +something like (the directory paths will be different): + +@example +cd c:/Examples/Example_2/ +gnatmake -o hello hello -g -cargs -gnatyt -bargs -largs +gcc -c -g -gnatyt hello.adb +hello.adb:4:04: "Put_Line" is not visible +hello.adb:4:04: non-visible declaration at a-textio.ads:264 +hello.adb:4:04: non-visible declaration at a-textio.ads:260 +hello.adb:4:12: (style) space required +gnatmake: "hello.adb" compilation error +@end example + +Compare this to the compiler output in @ref{No project files}; the +gnatmake option @code{-cargs -gnatq -gnatQ} has been replaced by +@code{-cargs -gnaty}, and an additional error is reported in +@file{hello.adb} on line 4. This shows that @file{hello.adp} is being +used to set the compiler options. + +Fixing the error, linking and running the code proceed as in @ref{No +project files}. + +@node Set source search path +@section Set source search path + +In this example, we show how to deal with files in more than one +directory. We start with the same code as in @ref{No project files}; +create those files (with the errors present) + +Create the directory @file{Example_3}, containing: + +@file{hello_pkg.ads}: + +@example +package Hello_Pkg is + procedure Say_Hello; +end Hello_Pkg; +@end example + +@file{hello_pkg.adb}: + +@example +with Ada.Text_IO; +package Hello_Pkg is + procedure Say_Hello + is begin + Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); + end Say_Hello; +end Hello_Pkg; +@end example + +These are the same files from example 1; @file{hello_pkg.adb} has an +error on line 2. + +In addition, create a directory @file{Example_3/Other}, containing these files: + +@file{Other/hello_3.adb}: + +@example +with Hello_Pkg; +with Ada.Text_IO; use Ada.Text_IO; +procedure Hello_3 +is begin + Hello_Pkg.Say_Hello; + Put_Line ("From hello_3"); +end Hello_3; +@end example + +There are no errors in this file. + +@file{Other/other.adp}: + +@example +src_dir=.. +comp_opt=-I.. +@end example + +Note that there must be no trailing spaces. + +In buffer @file{hello_3.adb}, invoke @samp{Ada | Project | Load...}, and +select @file{Example_3/Other/other.adp}. + +Then, again in @file{hello_3.adb}, invoke @samp{Ada | Set main and +Build}. You should get a @file{*compilation*} buffer containing +something like (the directory paths will be different): + +@example +cd c:/Examples/Example_3/Other/ +gnatmake -o hello_3 hello_3 -g -cargs -I.. -bargs -largs +gcc -c -g -I.. hello_3.adb +gcc -c -I./ -g -I.. -I- C:\Examples\Example_3\hello_pkg.adb +hello_pkg.adb:2:08: keyword "body" expected here [see file name] +gnatmake: "C:\Examples\Example_3\hello_pkg.adb" compilation error +@end example + +Compare the @code{-cargs} option to the compiler output in @ref{Set +compiler options}; this shows that @file{other.adp} is being used to +set the compiler options. + +Move to the error with @kbd{C-x `}. Ada mode searches the list of +directories given by @code{src_dir} for the file mentioned in the +compiler error message. + +Fixing the error, linking and running the code proceed as in @ref{No +project files}. + +@node Use GNAT project file +@section Use GNAT project file + +In this example, we show how to use a GNAT project file, with no Ada +mode project file. + +Create the directory @file{Example_4}, containing: + +@file{hello_pkg.ads}: + +@example +package Hello_Pkg is + procedure Say_Hello; +end Hello_Pkg; +@end example + +@file{hello_pkg.adb}: + +@example +with Ada.Text_IO; +package Hello_Pkg is + procedure Say_Hello + is begin + Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); + end Say_Hello; +end Hello_Pkg; +@end example + +These are the same files from example 1; @file{hello_pkg.adb} has an +error on line 2. + +In addition, create a directory @file{Example_4/Gnat_Project}, +containing these files: + +@file{Gnat_Project/hello_4.adb}: + +@example +with Hello_Pkg; +with Ada.Text_IO; use Ada.Text_IO; +procedure Hello_4 +is begin + Hello_Pkg.Say_Hello; + Put_Line ("From hello_4"); +end Hello_4; +@end example + +There are no errors in this file. + +@file{Gnat_Project/hello_4.gpr}: + +@example +Project Hello_4 is + for Source_Dirs use (".", ".."); +end Hello_4; +@end example + +In buffer @file{hello_4.adb}, invoke @samp{Ada | Project | Load...}, and +select @file{Example_4/Gnat_Project/hello_4.gpr}. + +Then, again in @file{hello_4.adb}, invoke @samp{Ada | Set main and +Build}. You should get a @file{*compilation*} buffer containing +something like (the directory paths will be different): + +@smallexample +cd c:/Examples/Example_4/Gnat_Project/ +gnatmake -o hello_4 hello_4 -Phello_4.gpr -cargs -gnatq -gnatQ -bargs -largs +gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\Gnat_Project\hello_4.adb +gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb +hello_pkg.adb:2:08: keyword "body" expected here [see file name] +gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error +@end smallexample + +Compare the @code{gcc} options to the compiler output in @ref{Set +compiler options}; this shows that @file{hello_4.gpr} is being used to +set the compiler options. + +Fixing the error, linking and running the code proceed as in @ref{No +project files}. + +@node Use multiple GNAT project files +@section Use multiple GNAT project files + +In this example, we show how to use multiple GNAT project files, +specifying the GNAT project search path in an Ada mode project file. + +Create the directory @file{Example_4} as specified in @ref{Use GNAT +project file}. + +Create the directory @file{Example_5}, containing: + +@file{hello_5.adb}: + +@example +with Hello_Pkg; +with Ada.Text_IO; use Ada.Text_IO; +procedure Hello_5 +is begin + Hello_Pkg.Say_Hello; + Put_Line ("From hello_5"); +end Hello_5; +@end example + +There are no errors in this file. + +@file{hello_5.adp}: + +@example +ada_project_path=../Example_4/Gnat_Project +gpr_file=hello_5.gpr +@end example + +@file{hello_5.gpr}: + +@example +with "hello_4"; +Project Hello_5 is + for Source_Dirs use ("."); + package Compiler is + for Default_Switches ("Ada") use ("-g", "-gnatyt"); + end Compiler; +end Hello_5; +@end example + +In buffer @file{hello_5.adb}, invoke @samp{Ada | Project | Load...}, and +select @file{Example_5/hello_5.adp}. + +Then, again in @file{hello_5.adb}, invoke @samp{Ada | Set main and +Build}. You should get a @file{*compilation*} buffer containing +something like (the directory paths will be different): + +@smallexample +cd c:/Examples/Example_5/ +gnatmake -o hello_5 hello_5 -Phello_5.gpr -g -cargs -gnatq -gnatQ -bargs -largs +gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_5\hello_5.adb +gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb +hello_pkg.adb:2:08: keyword "body" expected here [see file name] +gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error +@end smallexample + +Now type @kbd{C-x `}. @file{Example_4/hello_pkg.adb} is shown, +demonstrating that @file{hello_5.gpr} and @file{hello_4.gpr} are being +used to set the compilation search path. + +@node Moving Through Ada Code +@chapter Moving Through Ada Code + +There are several easy to use commands to navigate through Ada code. All +these functions are available through the Ada menu, and you can also +use the following key bindings or the command names. Some of these +menu entries are available only if the GNAT compiler is used, since +the implementation relies on the GNAT cross-referencing information. + +@table @kbd +@item M-C-e +@findex ada-next-procedure +Move to the next function/procedure/task, which ever comes next +(@code{ada-next-procedure}). +@item M-C-a +@findex ada-previous-procedure +Move to previous function/procedure/task +(@code{ada-previous-procedure}). +@item M-x ada-next-package +@findex ada-next-package +Move to next package. +@item M-x ada-previous-package +@findex ada-previous-package +Move to previous package. +@item C-c C-a +@findex ada-move-to-start +Move to matching start of @code{end} (@code{ada-move-to-start}). If +point is at the end of a subprogram, this command jumps to the +corresponding @code{begin} if the user option +@code{ada-move-to-declaration} is @code{nil} (default), otherwise it jumps to +the subprogram declaration. +@item C-c C-e +@findex ada-move-to-end +Move point to end of current block (@code{ada-move-to-end}). +@item C-c o +Switch between corresponding spec and body file +(@code{ff-find-other-file}). If point is in a subprogram, position +point on the corresponding declaration or body in the other file. +@item C-c c-d +@findex ada-goto-declaration +Move from any reference to its declaration, for from a declaration to +its body (for procedures, tasks, private and incomplete types). +@item C-c C-r +@findex ada-find-references +Runs the @file{gnatfind} command to search for all references to the +identifier surrounding point (@code{ada-find-references}). Use +@kbd{C-x `} (@code{next-error}) to visit each reference (as for +compilation errors). +@end table + +If the @code{ada-xref-create-ali} variable is non-@code{nil}, Emacs +will try to run GNAT for you whenever cross-reference information is +needed, and is older than the current source file. + +@node Identifier completion +@chapter Identifier completion + +Emacs and Ada mode provide two general ways for the completion of +identifiers. This is an easy way to type faster: you just have to type +the first few letters of an identifiers, and then loop through all the +possible completions. + +The first method is general for Emacs. It works by parsing all open +files for possible completions. + +For instance, if the words @samp{my_identifier}, @samp{my_subprogram} +are the only words starting with @samp{my} in any of the opened files, +then you will have this scenario: + +@example +You type: my@kbd{M-/} +Emacs inserts: @samp{my_identifier} +If you press @kbd{M-/} once again, Emacs replaces @samp{my_identifier} with +@samp{my_subprogram}. +Pressing @kbd{M-/} once more will bring you back to @samp{my_identifier}. +@end example + +This is a very fast way to do completion, and the casing of words will +also be respected. + +The second method (@kbd{C-@key{TAB}}) is specific to Ada mode and the GNAT +compiler. Emacs will search the cross-information for possible +completions. + +The main advantage is that this completion is more accurate: only +existing identifier will be suggested. + +On the other hand, this completion is a little bit slower and requires +that you have compiled your file at least once since you created that +identifier. + +@table @kbd +@item C-@key{TAB} +@findex ada-complete-identifier +Complete current identifier using cross-reference information. +@item M-/ +Complete identifier using buffer information (not Ada-specific). +@end table + +@node Automatic Smart Indentation +@chapter Automatic Smart Indentation + +Ada mode comes with a full set of rules for automatic indentation. You +can also configure the indentation, via the following variables: + +@table @asis +@item @code{ada-broken-indent} (default value: 2) +Number of columns to indent the continuation of a broken line. + +@item @code{ada-indent} (default value: 3) +Number of columns for default indentation. + +@item @code{ada-indent-record-rel-type} (default value: 3) +Indentation for @code{record} relative to @code{type} or @code{use}. + +@item @code{ada-indent-return} (default value: 0) +Indentation for @code{return} relative to @code{function} (if +@code{ada-indent-return} is greater than 0), or the open parenthesis +(if @code{ada-indent-return} is negative or 0). Note that in the second +case, when there is no open parenthesis, the indentation is done +relative to @code{function} with the value of @code{ada-broken-indent}. + +@item @code{ada-label-indent} (default value: -4) +Number of columns to indent a label. + +@item @code{ada-stmt-end-indent} (default value: 0) +Number of columns to indent a statement @code{end} keyword on a separate line. + +@item @code{ada-when-indent} (default value: 3) +Indentation for @code{when} relative to @code{exception} or @code{case}. + +@item @code{ada-indent-is-separate} (default value: t) +Non-@code{nil} means indent @code{is separate} or @code{is abstract} if on a single line. + +@item @code{ada-indent-to-open-paren} (default value: t) +Non-@code{nil} means indent according to the innermost open parenthesis. + +@item @code{ada-indent-after-return} (default value: t) +Non-@code{nil} means that the current line will also be re-indented +before inserting a newline, when you press @key{RET}. +@end table + +Most of the time, the indentation will be automatic, i.e., when you +press @key{RET}, the cursor will move to the correct column on the +next line. + +You can also indent single lines, or the current region, with @key{TAB}. + +Another mode of indentation exists that helps you to set up your +indentation scheme. If you press @kbd{C-c @key{TAB}}, Ada mode will do +the following: + +@itemize @bullet +@item +Reindent the current line, as @key{TAB} would do. +@item +Temporarily move the cursor to a reference line, i.e., the line that +was used to calculate the current indentation. +@item +Display in the message window the name of the variable that provided +the offset for the indentation. +@end itemize + +The exact indentation of the current line is the same as the one for the +reference line, plus an offset given by the variable. + +@table @kbd +@item @key{TAB} +Indent the current line or the current region. +@item C-M-\ +Indent lines in the current region. +@item C-c @key{TAB} +Indent the current line and display the name of the variable used for +indentation. +@end table + +@node Formatting Parameter Lists +@chapter Formatting Parameter Lists + +@table @kbd +@item C-c C-f +@findex ada-format-paramlist +Format the parameter list (@code{ada-format-paramlist}). +@end table + +This aligns the declarations on the colon (@samp{:}) separating +argument names and argument types, and aligns the @code{in}, +@code{out} and @code{in out} keywords. + +@node Automatic Casing +@chapter Automatic Casing + +Casing of identifiers, attributes and keywords is automatically +performed while typing when the variable @code{ada-auto-case} is set. +Every time you press a word separator, the previous word is +automatically cased. + +You can customize the automatic casing differently for keywords, +attributes and identifiers. The relevant variables are the following: +@code{ada-case-keyword}, @code{ada-case-attribute} and +@code{ada-case-identifier}. + +All these variables can have one of the following values: + +@table @code +@item downcase-word +The word will be lowercase. For instance @code{My_vARIable} is +converted to @code{my_variable}. + +@item upcase-word +The word will be uppercase. For instance @code{My_vARIable} is +converted to @code{MY_VARIABLE}. + +@item ada-capitalize-word +The first letter and each letter following an underscore (@samp{_}) +are uppercase, others are lowercase. For instance @code{My_vARIable} +is converted to @code{My_Variable}. + +@item ada-loose-case-word +Characters after an underscore @samp{_} character are uppercase, +others are not modified. For instance @code{My_vARIable} is converted +to @code{My_VARIable}. +@end table + +Ada mode allows you to define exceptions to these rules, in a file +specified by the variable @code{ada-case-exception-file} +(default @file{~/.emacs_case_exceptions}). Each line in this file +specifies the casing of one word or word fragment. Comments may be +included, separated from the word by a space. + +If the word starts with an asterisk (@samp{*}), it defines the casing +as a word fragment (or ``substring''); part of a word between two +underscores or word boundary. + +For example: + +@example +DOD Department of Defense +*IO +GNAT The GNAT compiler from Ada Core Technologies +@end example + +The word fragment @code{*IO} applies to any word containing ``_io''; +@code{Text_IO}, @code{Hardware_IO}, etc. + +@findex ada-create-case-exception +There are two ways to add new items to this file: you can simply edit +it as you would edit any text file. Or you can position point on the +word you want to add, and select menu @samp{Ada | Edit | Create Case +Exception}, or press @kbd{C-c C-y} (@code{ada-create-case-exception}). +The word will automatically be added to the current list of exceptions +and to the file. + +To define a word fragment case exception, select the word fragment, +then select menu @samp{Ada | Edit | Create Case Exception Substring}. + +It is sometimes useful to have multiple exception files around (for +instance, one could be the standard Ada acronyms, the second some +company specific exceptions, and the last one some project specific +exceptions). If you set up the variable @code{ada-case-exception-file} +as a list of files, each of them will be parsed and used in your emacs +session. However, when you save a new exception through the menu, as +described above, the new exception will be added to the first file in +the list. + +@table @kbd +@item C-c C-b +@findex ada-adjust-case-buffer +Adjust case in the whole buffer (@code{ada-adjust-case-buffer}). +@item C-c C-y +Create a new entry in the exception dictionary, with the word under +the cursor (@code{ada-create-case-exception}) +@item C-c C-t +@findex ada-case-read-exceptions +Rereads the exception dictionary from the file +@code{ada-case-exception-file} (@code{ada-case-read-exceptions}). +@end table + +@node Statement Templates +@chapter Statement Templates + +Templates are defined for most Ada statements, using the Emacs +``skeleton'' package. They can be inserted in the buffer using the +following commands: + +@table @kbd +@item C-c t b +@findex ada-exception-block +exception Block (@code{ada-exception-block}). +@item C-c t c +@findex ada-case +case (@code{ada-case}). +@item C-c t d +@findex ada-declare-block +declare Block (@code{ada-declare-block}). +@item C-c t e +@findex ada-else +else (@code{ada-else}). +@item C-c t f +@findex ada-for-loop +for Loop (@code{ada-for-loop}). +@item C-c t h +@findex ada-header +Header (@code{ada-header}). +@item C-c t i +@findex ada-if +if (@code{ada-if}). +@item C-c t k +@findex ada-package-body +package Body (@code{ada-package-body}). +@item C-c t l +@findex ada-loop +loop (@code{ada-loop}). +@item C-c p +@findex ada-subprogram-body +subprogram body (@code{ada-subprogram-body}). +@item C-c t t +@findex ada-task-body +task Body (@code{ada-task-body}). +@item C-c t w +@findex ada-while +while Loop (@code{ada-while}). +@item C-c t u +@findex ada-use +use (@code{ada-use}). +@item C-c t x +@findex ada-exit +exit (@code{ada-exit}). +@item C-c t C-a +@findex ada-array +array (@code{ada-array}). +@item C-c t C-e +@findex ada-elsif +elsif (@code{ada-elsif}). +@item C-c t C-f +@findex ada-function-spec +function Spec (@code{ada-function-spec}). +@item C-c t C-k +@findex ada-package-spec +package Spec (@code{ada-package-spec}). +@item C-c t C-p +@findex ada-procedure-spec +procedure Spec (@code{ada-package-spec}. +@item C-c t C-r +@findex ada-record +record (@code{ada-record}). +@item C-c t C-s +@findex ada-subtype +subtype (@code{ada-subtype}). +@item C-c t C-t +@findex ada-task-spec +task Spec (@code{ada-task-spec}). +@item C-c t C-u +@findex ada-with +with (@code{ada-with}). +@item C-c t C-v +@findex ada-private +private (@code{ada-private}). +@item C-c t C-w +@findex ada-when +when (@code{ada-when}). +@item C-c t C-x +@findex ada-exception +exception (@code{ada-exception}). +@item C-c t C-y +@findex ada-type +type (@code{ada-type}). +@end table + +@node Comment Handling +@chapter Comment Handling + +By default, comment lines get indented like Ada code. There are a few +additional functions to handle comments: + +@table @kbd +@item M-; +Start a comment in default column. +@item M-j +Continue comment on next line. +@item C-c ; +Comment the selected region (add @samp{--} at the beginning of lines). +@item C-c : +Uncomment the selected region +@item M-q +autofill the current comment. +@end table + +@node GNU Free Documentation License +@appendix GNU Free Documentation License +@include doclicense.texi + +@node Index +@unnumbered Index + +@printindex fn + +@bye diff --git a/old-ada/doc/build.sh b/old-ada/doc/build.sh new file mode 100755 index 0000000..a0799fe --- /dev/null +++ b/old-ada/doc/build.sh @@ -0,0 +1,3 @@ +#! /usr/bin/env bash +texi2any -o ada-mode.info --no-split ada-mode.texi +texi2any --html -o ada-mode.html --no-split ada-mode.texi diff --git a/old-ada/doc/clean.sh b/old-ada/doc/clean.sh new file mode 100755 index 0000000..f7e90b1 --- /dev/null +++ b/old-ada/doc/clean.sh @@ -0,0 +1,2 @@ +#! /bin/sh +rm ada-mode.aux ada-mode.fn ada-mode.log ada-mode.toc diff --git a/old-ada/doc/doclicense.texi b/old-ada/doc/doclicense.texi new file mode 100644 index 0000000..eaf3da0 --- /dev/null +++ b/old-ada/doc/doclicense.texi @@ -0,0 +1,505 @@ +@c The GNU Free Documentation License. +@center Version 1.3, 3 November 2008 + +@c This file is intended to be included within another document, +@c hence no sectioning command or @node. + +@display +Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. +@uref{https://fsf.org/} + +Everyone is permitted to copy and distribute verbatim copies +of this license document, but changing it is not allowed. +@end display + +@enumerate 0 +@item +PREAMBLE + +The purpose of this License is to make a manual, textbook, or other +functional and useful document @dfn{free} in the sense of freedom: to +assure everyone the effective freedom to copy and redistribute it, +with or without modifying it, either commercially or noncommercially. +Secondarily, this License preserves for the author and publisher a way +to get credit for their work, while not being considered responsible +for modifications made by others. + +This License is a kind of ``copyleft'', which means that derivative +works of the document must themselves be free in the same sense. It +complements the GNU General Public License, which is a copyleft +license designed for free software. + +We have designed this License in order to use it for manuals for free +software, because free software needs free documentation: a free +program should come with manuals providing the same freedoms that the +software does. But this License is not limited to software manuals; +it can be used for any textual work, regardless of subject matter or +whether it is published as a printed book. We recommend this License +principally for works whose purpose is instruction or reference. + +@item +APPLICABILITY AND DEFINITIONS + +This License applies to any manual or other work, in any medium, that +contains a notice placed by the copyright holder saying it can be +distributed under the terms of this License. Such a notice grants a +world-wide, royalty-free license, unlimited in duration, to use that +work under the conditions stated herein. The ``Document'', below, +refers to any such manual or work. Any member of the public is a +licensee, and is addressed as ``you''. You accept the license if you +copy, modify or distribute the work in a way requiring permission +under copyright law. + +A ``Modified Version'' of the Document means any work containing the +Document or a portion of it, either copied verbatim, or with +modifications and/or translated into another language. + +A ``Secondary Section'' is a named appendix or a front-matter section +of the Document that deals exclusively with the relationship of the +publishers or authors of the Document to the Document's overall +subject (or to related matters) and contains nothing that could fall +directly within that overall subject. (Thus, if the Document is in +part a textbook of mathematics, a Secondary Section may not explain +any mathematics.) The relationship could be a matter of historical +connection with the subject or with related matters, or of legal, +commercial, philosophical, ethical or political position regarding +them. + +The ``Invariant Sections'' are certain Secondary Sections whose titles +are designated, as being those of Invariant Sections, in the notice +that says that the Document is released under this License. If a +section does not fit the above definition of Secondary then it is not +allowed to be designated as Invariant. The Document may contain zero +Invariant Sections. If the Document does not identify any Invariant +Sections then there are none. + +The ``Cover Texts'' are certain short passages of text that are listed, +as Front-Cover Texts or Back-Cover Texts, in the notice that says that +the Document is released under this License. A Front-Cover Text may +be at most 5 words, and a Back-Cover Text may be at most 25 words. + +A ``Transparent'' copy of the Document means a machine-readable copy, +represented in a format whose specification is available to the +general public, that is suitable for revising the document +straightforwardly with generic text editors or (for images composed of +pixels) generic paint programs or (for drawings) some widely available +drawing editor, and that is suitable for input to text formatters or +for automatic translation to a variety of formats suitable for input +to text formatters. A copy made in an otherwise Transparent file +format whose markup, or absence of markup, has been arranged to thwart +or discourage subsequent modification by readers is not Transparent. +An image format is not Transparent if used for any substantial amount +of text. A copy that is not ``Transparent'' is called ``Opaque''. + +Examples of suitable formats for Transparent copies include plain +ASCII without markup, Texinfo input format, La@TeX{} input +format, SGML or XML using a publicly available +DTD, and standard-conforming simple HTML, +PostScript or PDF designed for human modification. Examples +of transparent image formats include PNG, XCF and +JPG@. Opaque formats include proprietary formats that can be +read and edited only by proprietary word processors, SGML or +XML for which the DTD and/or processing tools are +not generally available, and the machine-generated HTML, +PostScript or PDF produced by some word processors for +output purposes only. + +The ``Title Page'' means, for a printed book, the title page itself, +plus such following pages as are needed to hold, legibly, the material +this License requires to appear in the title page. For works in +formats which do not have any title page as such, ``Title Page'' means +the text near the most prominent appearance of the work's title, +preceding the beginning of the body of the text. + +The ``publisher'' means any person or entity that distributes copies +of the Document to the public. + +A section ``Entitled XYZ'' means a named subunit of the Document whose +title either is precisely XYZ or contains XYZ in parentheses following +text that translates XYZ in another language. (Here XYZ stands for a +specific section name mentioned below, such as ``Acknowledgements'', +``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title'' +of such a section when you modify the Document means that it remains a +section ``Entitled XYZ'' according to this definition. + +The Document may include Warranty Disclaimers next to the notice which +states that this License applies to the Document. These Warranty +Disclaimers are considered to be included by reference in this +License, but only as regards disclaiming warranties: any other +implication that these Warranty Disclaimers may have is void and has +no effect on the meaning of this License. + +@item +VERBATIM COPYING + +You may copy and distribute the Document in any medium, either +commercially or noncommercially, provided that this License, the +copyright notices, and the license notice saying this License applies +to the Document are reproduced in all copies, and that you add no other +conditions whatsoever to those of this License. You may not use +technical measures to obstruct or control the reading or further +copying of the copies you make or distribute. However, you may accept +compensation in exchange for copies. If you distribute a large enough +number of copies you must also follow the conditions in section 3. + +You may also lend copies, under the same conditions stated above, and +you may publicly display copies. + +@item +COPYING IN QUANTITY + +If you publish printed copies (or copies in media that commonly have +printed covers) of the Document, numbering more than 100, and the +Document's license notice requires Cover Texts, you must enclose the +copies in covers that carry, clearly and legibly, all these Cover +Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on +the back cover. Both covers must also clearly and legibly identify +you as the publisher of these copies. The front cover must present +the full title with all words of the title equally prominent and +visible. You may add other material on the covers in addition. +Copying with changes limited to the covers, as long as they preserve +the title of the Document and satisfy these conditions, can be treated +as verbatim copying in other respects. + +If the required texts for either cover are too voluminous to fit +legibly, you should put the first ones listed (as many as fit +reasonably) on the actual cover, and continue the rest onto adjacent +pages. + +If you publish or distribute Opaque copies of the Document numbering +more than 100, you must either include a machine-readable Transparent +copy along with each Opaque copy, or state in or with each Opaque copy +a computer-network location from which the general network-using +public has access to download using public-standard network protocols +a complete Transparent copy of the Document, free of added material. +If you use the latter option, you must take reasonably prudent steps, +when you begin distribution of Opaque copies in quantity, to ensure +that this Transparent copy will remain thus accessible at the stated +location until at least one year after the last time you distribute an +Opaque copy (directly or through your agents or retailers) of that +edition to the public. + +It is requested, but not required, that you contact the authors of the +Document well before redistributing any large number of copies, to give +them a chance to provide you with an updated version of the Document. + +@item +MODIFICATIONS + +You may copy and distribute a Modified Version of the Document under +the conditions of sections 2 and 3 above, provided that you release +the Modified Version under precisely this License, with the Modified +Version filling the role of the Document, thus licensing distribution +and modification of the Modified Version to whoever possesses a copy +of it. In addition, you must do these things in the Modified Version: + +@enumerate A +@item +Use in the Title Page (and on the covers, if any) a title distinct +from that of the Document, and from those of previous versions +(which should, if there were any, be listed in the History section +of the Document). You may use the same title as a previous version +if the original publisher of that version gives permission. + +@item +List on the Title Page, as authors, one or more persons or entities +responsible for authorship of the modifications in the Modified +Version, together with at least five of the principal authors of the +Document (all of its principal authors, if it has fewer than five), +unless they release you from this requirement. + +@item +State on the Title page the name of the publisher of the +Modified Version, as the publisher. + +@item +Preserve all the copyright notices of the Document. + +@item +Add an appropriate copyright notice for your modifications +adjacent to the other copyright notices. + +@item +Include, immediately after the copyright notices, a license notice +giving the public permission to use the Modified Version under the +terms of this License, in the form shown in the Addendum below. + +@item +Preserve in that license notice the full lists of Invariant Sections +and required Cover Texts given in the Document's license notice. + +@item +Include an unaltered copy of this License. + +@item +Preserve the section Entitled ``History'', Preserve its Title, and add +to it an item stating at least the title, year, new authors, and +publisher of the Modified Version as given on the Title Page. If +there is no section Entitled ``History'' in the Document, create one +stating the title, year, authors, and publisher of the Document as +given on its Title Page, then add an item describing the Modified +Version as stated in the previous sentence. + +@item +Preserve the network location, if any, given in the Document for +public access to a Transparent copy of the Document, and likewise +the network locations given in the Document for previous versions +it was based on. These may be placed in the ``History'' section. +You may omit a network location for a work that was published at +least four years before the Document itself, or if the original +publisher of the version it refers to gives permission. + +@item +For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve +the Title of the section, and preserve in the section all the +substance and tone of each of the contributor acknowledgements and/or +dedications given therein. + +@item +Preserve all the Invariant Sections of the Document, +unaltered in their text and in their titles. Section numbers +or the equivalent are not considered part of the section titles. + +@item +Delete any section Entitled ``Endorsements''. Such a section +may not be included in the Modified Version. + +@item +Do not retitle any existing section to be Entitled ``Endorsements'' or +to conflict in title with any Invariant Section. + +@item +Preserve any Warranty Disclaimers. +@end enumerate + +If the Modified Version includes new front-matter sections or +appendices that qualify as Secondary Sections and contain no material +copied from the Document, you may at your option designate some or all +of these sections as invariant. To do this, add their titles to the +list of Invariant Sections in the Modified Version's license notice. +These titles must be distinct from any other section titles. + +You may add a section Entitled ``Endorsements'', provided it contains +nothing but endorsements of your Modified Version by various +parties---for example, statements of peer review or that the text has +been approved by an organization as the authoritative definition of a +standard. + +You may add a passage of up to five words as a Front-Cover Text, and a +passage of up to 25 words as a Back-Cover Text, to the end of the list +of Cover Texts in the Modified Version. Only one passage of +Front-Cover Text and one of Back-Cover Text may be added by (or +through arrangements made by) any one entity. If the Document already +includes a cover text for the same cover, previously added by you or +by arrangement made by the same entity you are acting on behalf of, +you may not add another; but you may replace the old one, on explicit +permission from the previous publisher that added the old one. + +The author(s) and publisher(s) of the Document do not by this License +give permission to use their names for publicity for or to assert or +imply endorsement of any Modified Version. + +@item +COMBINING DOCUMENTS + +You may combine the Document with other documents released under this +License, under the terms defined in section 4 above for modified +versions, provided that you include in the combination all of the +Invariant Sections of all of the original documents, unmodified, and +list them all as Invariant Sections of your combined work in its +license notice, and that you preserve all their Warranty Disclaimers. + +The combined work need only contain one copy of this License, and +multiple identical Invariant Sections may be replaced with a single +copy. If there are multiple Invariant Sections with the same name but +different contents, make the title of each such section unique by +adding at the end of it, in parentheses, the name of the original +author or publisher of that section if known, or else a unique number. +Make the same adjustment to the section titles in the list of +Invariant Sections in the license notice of the combined work. + +In the combination, you must combine any sections Entitled ``History'' +in the various original documents, forming one section Entitled +``History''; likewise combine any sections Entitled ``Acknowledgements'', +and any sections Entitled ``Dedications''. You must delete all +sections Entitled ``Endorsements.'' + +@item +COLLECTIONS OF DOCUMENTS + +You may make a collection consisting of the Document and other documents +released under this License, and replace the individual copies of this +License in the various documents with a single copy that is included in +the collection, provided that you follow the rules of this License for +verbatim copying of each of the documents in all other respects. + +You may extract a single document from such a collection, and distribute +it individually under this License, provided you insert a copy of this +License into the extracted document, and follow this License in all +other respects regarding verbatim copying of that document. + +@item +AGGREGATION WITH INDEPENDENT WORKS + +A compilation of the Document or its derivatives with other separate +and independent documents or works, in or on a volume of a storage or +distribution medium, is called an ``aggregate'' if the copyright +resulting from the compilation is not used to limit the legal rights +of the compilation's users beyond what the individual works permit. +When the Document is included in an aggregate, this License does not +apply to the other works in the aggregate which are not themselves +derivative works of the Document. + +If the Cover Text requirement of section 3 is applicable to these +copies of the Document, then if the Document is less than one half of +the entire aggregate, the Document's Cover Texts may be placed on +covers that bracket the Document within the aggregate, or the +electronic equivalent of covers if the Document is in electronic form. +Otherwise they must appear on printed covers that bracket the whole +aggregate. + +@item +TRANSLATION + +Translation is considered a kind of modification, so you may +distribute translations of the Document under the terms of section 4. +Replacing Invariant Sections with translations requires special +permission from their copyright holders, but you may include +translations of some or all Invariant Sections in addition to the +original versions of these Invariant Sections. You may include a +translation of this License, and all the license notices in the +Document, and any Warranty Disclaimers, provided that you also include +the original English version of this License and the original versions +of those notices and disclaimers. In case of a disagreement between +the translation and the original version of this License or a notice +or disclaimer, the original version will prevail. + +If a section in the Document is Entitled ``Acknowledgements'', +``Dedications'', or ``History'', the requirement (section 4) to Preserve +its Title (section 1) will typically require changing the actual +title. + +@item +TERMINATION + +You may not copy, modify, sublicense, or distribute the Document +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense, or distribute it is void, and +will automatically terminate your rights under this License. + +However, if you cease all violation of this License, then your license +from a particular copyright holder is reinstated (a) provisionally, +unless and until the copyright holder explicitly and finally +terminates your license, and (b) permanently, if the copyright holder +fails to notify you of the violation by some reasonable means prior to +60 days after the cessation. + +Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + +Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, receipt of a copy of some or all of the same material does +not give you any rights to use it. + +@item +FUTURE REVISIONS OF THIS LICENSE + +The Free Software Foundation may publish new, revised versions +of the GNU Free Documentation License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. See +@uref{https://www.gnu.org/licenses/}. + +Each version of the License is given a distinguishing version number. +If the Document specifies that a particular numbered version of this +License ``or any later version'' applies to it, you have the option of +following the terms and conditions either of that specified version or +of any later version that has been published (not as a draft) by the +Free Software Foundation. If the Document does not specify a version +number of this License, you may choose any version ever published (not +as a draft) by the Free Software Foundation. If the Document +specifies that a proxy can decide which future versions of this +License can be used, that proxy's public statement of acceptance of a +version permanently authorizes you to choose that version for the +Document. + +@item +RELICENSING + +``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any +World Wide Web server that publishes copyrightable works and also +provides prominent facilities for anybody to edit those works. A +public wiki that anybody can edit is an example of such a server. A +``Massive Multiauthor Collaboration'' (or ``MMC'') contained in the +site means any set of copyrightable works thus published on the MMC +site. + +``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0 +license published by Creative Commons Corporation, a not-for-profit +corporation with a principal place of business in San Francisco, +California, as well as future copyleft versions of that license +published by that same organization. + +``Incorporate'' means to publish or republish a Document, in whole or +in part, as part of another Document. + +An MMC is ``eligible for relicensing'' if it is licensed under this +License, and if all works that were first published under this License +somewhere other than this MMC, and subsequently incorporated in whole +or in part into the MMC, (1) had no cover texts or invariant sections, +and (2) were thus incorporated prior to November 1, 2008. + +The operator of an MMC Site may republish an MMC contained in the site +under CC-BY-SA on the same site at any time before August 1, 2009, +provided the MMC is eligible for relicensing. + +@end enumerate + +@page +@heading ADDENDUM: How to use this License for your documents + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and +license notices just after the title page: + +@smallexample +@group + Copyright (C) @var{year} @var{your name}. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.3 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. +@end group +@end smallexample + +If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, +replace the ``with@dots{}Texts.''@: line with this: + +@smallexample +@group + with the Invariant Sections being @var{list their titles}, with + the Front-Cover Texts being @var{list}, and with the Back-Cover Texts + being @var{list}. +@end group +@end smallexample + +If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + +If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of +free software license, such as the GNU General Public License, +to permit their use in free software. + +@c Local Variables: +@c ispell-local-pdict: "ispell-dict" +@c End: diff --git a/old-ada/doc/docstyle.texi b/old-ada/doc/docstyle.texi new file mode 100644 index 0000000..e740439 --- /dev/null +++ b/old-ada/doc/docstyle.texi @@ -0,0 +1,19 @@ +@c Emacs documentation style settings +@documentencoding UTF-8 +@c These two require Texinfo 5.0 or later, so we use the older +@c equivalent @set variables supported in 4.11 and hence +@ignore +@codequotebacktick on +@codequoteundirected on +@end ignore +@set txicodequoteundirected +@set txicodequotebacktick +@iftex +@c It turns out TeX sometimes fails to hyphenate, so we help it here +@hyphenation{au-to-mat-i-cal-ly} +@hyphenation{spec-i-fied} +@hyphenation{work-a-round} +@hyphenation{work-a-rounds} +@hyphenation{un-marked} +@hyphenation{dic-tion-ary} +@end iftex diff --git a/old_ada/LICENSE b/old_ada/LICENSE deleted file mode 100644 index f288702..0000000 --- a/old_ada/LICENSE +++ /dev/null @@ -1,674 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU General Public License is a free, copyleft license for -software and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU Affero General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the special requirements of the GNU Affero General Public License, -section 13, concerning interaction through a network will apply to the -combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - Copyright (C) - This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, your program's commands -might be different; for a GUI interface, you would use an "about box". - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU GPL, see -. - - The GNU General Public License does not permit incorporating your program -into proprietary programs. If your program is a subroutine library, you -may consider it more useful to permit linking proprietary applications with -the library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. But first, please read -. diff --git a/old_ada/README.rst b/old_ada/README.rst deleted file mode 100644 index ec54e47..0000000 --- a/old_ada/README.rst +++ /dev/null @@ -1,39 +0,0 @@ -Old ada-mode.el -=============== - -This is a fork of the old version of ``ada-mode.el`` that was -distributed with Emacs. - -I was unable to get the newer packaged version of ``ada-mode.el``, -which uses an external program for indentation, fontification, and -navigation, to work after trying on several operating systems. - -However, the old version worked fine for me. - -So I dug it out of the `Emacs git repository`_ at `savannah.gnu.org`_. -Basically, I cloned the git repository and then figured out what -commit it was deleted in by doing:: - - $ git rev-list HEAD -n 1 -- lisp/progmodes/ada-mode.el - a13c64204c8ead966789abf8efe176e4f2d4f599 - -Then I checked out the files involved:: - - $ git checkout a13c64204c8ead966789abf8efe176e4f2d4f599^ lisp/progmodes/ada-mode.el lisp/progmodes/ada-prj.el lisp/progmodes/ada-stmt.el lisp/progmodes/ada-xref.el doc/misc/ada-mode.texi doc/docstyle.texi doc/doclicense.texi - -The ``^`` at the end of the commit hash says to get the previous -commit. - -This formed the initial checking for this repository. - -It turns out that Emacs 28 doesn't automatically add ada files to -``auto-mode-alist`` (see `issue #2`_). So, do the following: - -.. _issue #2: https://github.com/tkurtbond/old-ada-mode/issues/2 - -.. code:: emacs-lisp - - (cl-loop for ext in '("\\.gpr$" "\\.ada$" "\\.ads$" "\\.adb$") - do (add-to-list 'auto-mode-alist (cons ext 'ada-mode))) - - diff --git a/old_ada/ada-mode.el b/old_ada/ada-mode.el deleted file mode 100644 index b7f0535..0000000 --- a/old_ada/ada-mode.el +++ /dev/null @@ -1,5494 +0,0 @@ -;;; ada-mode.el --- major-mode for editing Ada sources - -;; Copyright (C) 1994-1995, 1997-2019 Free Software Foundation, Inc. - -;; Author: Rolf Ebert -;; Markus Heritsch -;; Emmanuel Briot -;; Maintainer: Stephen Leake -;; Keywords: languages ada -;; Version: 4.0 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; This mode is a major mode for editing Ada code. This is a major -;; rewrite of the file packaged with Emacs-20. The Ada mode is -;; composed of four Lisp files: ada-mode.el, ada-xref.el, ada-prj.el -;; and ada-stmt.el. Only this file (ada-mode.el) is completely -;; independent from the GNU Ada compiler GNAT, distributed by Ada -;; Core Technologies. All the other files rely heavily on features -;; provided only by GNAT. - -;;; Usage: -;; Emacs should enter Ada mode automatically when you load an Ada file. -;; By default, the valid extensions for Ada files are .ads, .adb or .ada -;; If the ada-mode does not start automatically, then simply type the -;; following command : -;; M-x ada-mode -;; -;; By default, ada-mode is configured to take full advantage of the GNAT -;; compiler (the menus will include the cross-referencing features,...). -;; If you are using another compiler, you might want to set the following -;; variable in your .emacs (Note: do not set this in the ada-mode-hook, it -;; won't work) : -;; (setq ada-which-compiler 'generic) -;; -;; This mode requires find-file.el to be present on your system. - -;;; History: -;; The first Ada mode for GNU Emacs was written by V. Broman in -;; 1985. He based his work on the already existing Modula-2 mode. -;; This was distributed as ada.el in versions of Emacs prior to 19.29. -;; -;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of -;; several files with support for dired commands and other nice -;; things. It is currently available from the PAL -;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z. -;; -;; The probably very first Ada mode (called electric-ada.el) was -;; written by Steven D. Litvintchouk and Steven M. Rosen for the -;; Gosling Emacs. L. Slater based his development on ada.el and -;; electric-ada.el. -;; -;; A complete rewrite by M. Heritsch and R. Ebert has been done. -;; Some ideas from the Ada mode mailing list have been -;; added. Some of the functionality of L. Slater's mode has not -;; (yet) been recoded in this new mode. Perhaps you prefer sticking -;; to his version. -;; -;; A complete rewrite for Emacs-20 / GNAT-3.11 has been done by Ada Core -;; Technologies. - -;;; Credits: -;; Many thanks to John McCabe for sending so -;; many patches included in this package. -;; Christian Egli : -;; ada-imenu-generic-expression -;; Many thanks also to the following persons that have contributed -;; to the ada-mode -;; Philippe Waroquiers (PW) in particular, -;; woodruff@stc.llnl.gov (John Woodruff) -;; jj@ddci.dk (Jesper Joergensen) -;; gse@ocsystems.com (Scott Evans) -;; comar@gnat.com (Cyrille Comar) -;; stephen.leake@gsfc.nasa.gov (Stephen Leake) -;; robin-reply@reagans.org -;; and others for their valuable hints. - -;;; Code: -;; Note: Every function in this package is compiler-independent. -;; The names start with ada- -;; The variables that the user can edit can all be modified through -;; the customize mode. They are sorted in alphabetical order in this -;; file. - -;; Supported packages. -;; This package supports a number of other Emacs modes. These other modes -;; should be loaded before the ada-mode, which will then setup some variables -;; to improve the support for Ada code. -;; Here is the list of these modes: -;; `which-function-mode': Display in the mode line the name of the subprogram -;; the cursor is in. -;; `outline-mode': Provides the capability to collapse or expand the code -;; for specific language constructs, for instance if you want to hide the -;; code corresponding to a subprogram -;; `align': This mode is now provided with Emacs 21, but can also be -;; installed manually for older versions of Emacs. It provides the -;; capability to automatically realign the selected region (for instance -;; all ':=', ':' and '--' will be aligned on top of each other. -;; `imenu': Provides a menu with the list of entities defined in the current -;; buffer, and an easy way to jump to any of them -;; `speedbar': Provides a separate file browser, and the capability for each -;; file to see the list of entities defined in it and to jump to them -;; easily -;; `abbrev-mode': Provides the capability to define abbreviations, which -;; are automatically expanded when you type them. See the Emacs manual. - -(require 'find-file nil t) -(require 'align nil t) -(require 'which-func nil t) -(require 'compile nil t) - -(defvar ispell-check-comments) -(defvar skeleton-further-elements) - -(define-error 'ada-mode-errors nil) - -(defun ada-mode-version () - "Return Ada mode version." - (interactive) - (let ((version-string "4.00")) - (if (called-interactively-p 'interactive) - (message version-string) - version-string))) - -(defvar ada-mode-hook nil - "List of functions to call when Ada mode is invoked. -This hook is automatically executed after the `ada-mode' is -fully loaded. -This is a good place to add Ada environment specific bindings.") - -(defgroup ada nil - "Major mode for editing and compiling Ada source in Emacs." - :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) - :link '(custom-manual "(ada-mode) Top") - :link '(emacs-commentary-link :tag "Commentary" "ada-mode.el") - :group 'languages) - -(defcustom ada-auto-case t - "Non-nil means automatically change case of preceding word while typing. -Casing is done according to `ada-case-keyword', `ada-case-identifier' -and `ada-case-attribute'." - :type 'boolean :group 'ada) - -(defcustom ada-broken-decl-indent 0 - "Number of columns to indent a broken declaration. - -An example is : - declare - A, - >>>>>B : Integer;" - :type 'integer :group 'ada) - -(defcustom ada-broken-indent 2 - "Number of columns to indent the continuation of a broken line. - -An example is : - My_Var : My_Type := (Field1 => - >>>>>>>>>Value);" - :type 'integer :group 'ada) - -(defcustom ada-continuation-indent ada-broken-indent - "Number of columns to indent the continuation of broken lines in parenthesis. - -An example is : - Func (Param1, - >>>>>Param2);" - :type 'integer :group 'ada) - -(defcustom ada-case-attribute 'ada-capitalize-word - "Function to call to adjust the case of Ada attributes. -It may be `downcase-word', `upcase-word', `ada-loose-case-word', -`ada-capitalize-word' or `ada-no-auto-case'." - :type '(choice (const downcase-word) - (const upcase-word) - (const ada-capitalize-word) - (const ada-loose-case-word) - (const ada-no-auto-case)) - :group 'ada) - -(defcustom ada-case-exception-file - (list (convert-standard-filename' "~/.emacs_case_exceptions")) - "List of special casing exceptions dictionaries for identifiers. -The first file is the one where new exceptions will be saved by Emacs -when you call `ada-create-case-exception'. - -These files should contain one word per line, that gives the casing -to be used for that word in Ada files. If the line starts with the -character *, then the exception will be used for substrings that either -start at the beginning of a word or after a _ character, and end either -at the end of the word or at a _ character. Each line can be terminated -by a comment." - :type '(repeat (file)) - :group 'ada) - -(defcustom ada-case-keyword 'downcase-word - "Function to call to adjust the case of an Ada keywords. -It may be `downcase-word', `upcase-word', `ada-loose-case-word' or -`ada-capitalize-word'." - :type '(choice (const downcase-word) - (const upcase-word) - (const ada-capitalize-word) - (const ada-loose-case-word) - (const ada-no-auto-case)) - :group 'ada) - -(defcustom ada-case-identifier 'ada-loose-case-word - "Function to call to adjust the case of an Ada identifier. -It may be `downcase-word', `upcase-word', `ada-loose-case-word' or -`ada-capitalize-word'." - :type '(choice (const downcase-word) - (const upcase-word) - (const ada-capitalize-word) - (const ada-loose-case-word) - (const ada-no-auto-case)) - :group 'ada) - -(defcustom ada-clean-buffer-before-saving t - "Non-nil means remove trailing spaces and untabify the buffer before saving." - :type 'boolean :group 'ada) -(make-obsolete-variable 'ada-clean-buffer-before-saving - "it has no effect - use `write-file-functions' hook." - "23.2") - - -(defcustom ada-indent 3 - "Size of Ada indentation. - -An example is : -procedure Foo is -begin ->>>>>>>>>>null;" - :type 'integer :group 'ada) - -(defcustom ada-indent-after-return t - "Non-nil means automatically indent after RET or LFD." - :type 'boolean :group 'ada) - -(defcustom ada-indent-align-comments t - "Non-nil means align comments on previous line comments, if any. -If nil, indentation is calculated as usual. -Note that indentation is calculated only if `ada-indent-comment-as-code' is t. - -For instance: - A := 1; -- A multi-line comment - -- aligned if `ada-indent-align-comments' is t" - :type 'boolean :group 'ada) - -(defcustom ada-indent-comment-as-code t - "Non-nil means indent comment lines as code. -A nil value means do not auto-indent comments." - :type 'boolean :group 'ada) - -(defcustom ada-indent-handle-comment-special nil - "Non-nil if comment lines should be handled specially inside parenthesis. -By default, if the line that contains the open parenthesis has some -text following it, then the following lines will be indented in the -same column as this text. This will not be true if the first line is -a comment and `ada-indent-handle-comment-special' is t. - -type A is - ( Value_1, -- common behavior, when not a comment - Value_2); - -type A is - ( -- `ada-indent-handle-comment-special' is nil - Value_1, - Value_2); - -type A is - ( -- `ada-indent-handle-comment-special' is non-nil - Value_1, - Value_2);" - :type 'boolean :group 'ada) - -(defcustom ada-indent-is-separate t - "Non-nil means indent `is separate' or `is abstract' if on a single line." - :type 'boolean :group 'ada) - -(defcustom ada-indent-record-rel-type 3 - "Indentation for `record' relative to `type' or `use'. - -An example is: - type A is - >>>>>>>>>>>record" - :type 'integer :group 'ada) - -(defcustom ada-indent-renames ada-broken-indent - "Indentation for renames relative to the matching function statement. -If `ada-indent-return' is null or negative, the indentation is done relative to -the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used). - -An example is: - function A (B : Integer) - return C; - >>>renames Foo;" - :type 'integer :group 'ada) - -(defcustom ada-indent-return 0 - "Indentation for `return' relative to the matching `function' statement. -If `ada-indent-return' is null or negative, the indentation is done relative to -the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used). - -An example is: - function A (B : Integer) - >>>>>return C;" - :type 'integer :group 'ada) - -(defcustom ada-indent-to-open-paren t - "Non-nil means indent according to the innermost open parenthesis." - :type 'boolean :group 'ada) - -(defcustom ada-fill-comment-prefix "-- " - "Text inserted in the first columns when filling a comment paragraph. -Note: if you modify this variable, you will have to invoke `ada-mode' -again to take account of the new value." - :type 'string :group 'ada) - -(defcustom ada-fill-comment-postfix " --" - "Text inserted at the end of each line when filling a comment paragraph. -Used by `ada-fill-comment-paragraph-postfix'." - :type 'string :group 'ada) - -(defcustom ada-label-indent -4 - "Number of columns to indent a label. - -An example is: -procedure Foo is -begin ->>>>Label: - -This is also used for <<..>> labels" - :type 'integer :group 'ada) - -(defcustom ada-language-version 'ada95 - "Ada language version; one of `ada83', `ada95', `ada2005'." - :type '(choice (const ada83) (const ada95) (const ada2005)) :group 'ada) - -(defcustom ada-move-to-declaration nil - "Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to `begin'." - :type 'boolean :group 'ada) - -(defcustom ada-popup-key '[down-mouse-3] - "Key used for binding the contextual menu. -If nil, no contextual menu is available." - :type '(restricted-sexp :match-alternatives (stringp vectorp)) - :group 'ada) - -(defcustom ada-search-directories - (append '(".") - (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":") - '("/usr/adainclude" "/usr/local/adainclude" - "/opt/gnu/adainclude")) - "Default list of directories to search for Ada files. -See the description for the `ff-search-directories' variable. This variable -is the initial value of `ada-search-directories-internal'." - :type '(repeat (choice :tag "Directory" - (const :tag "default" nil) - (directory :format "%v"))) - :group 'ada) - -(defvar ada-search-directories-internal ada-search-directories - "Internal version of `ada-search-directories'. -Its value is the concatenation of the search path as read in the project file -and the standard runtime location, and the value of the user-defined -`ada-search-directories'.") - -(defcustom ada-stmt-end-indent 0 - "Number of columns to indent the end of a statement on a separate line. - -An example is: - if A = B - >>>>then" - :type 'integer :group 'ada) - -(defcustom ada-tab-policy 'indent-auto - "Control the behavior of the TAB key. -Must be one of : -`indent-rigidly' : always adds `ada-indent' blanks at the beginning of the line. -`indent-auto' : use indentation functions in this file. -`always-tab' : do `indent-relative'." - :type '(choice (const indent-auto) - (const indent-rigidly) - (const always-tab)) - :group 'ada) - -(defcustom ada-use-indent ada-broken-indent - "Indentation for the lines in a `use' statement. - -An example is: - use Ada.Text_IO, - >>>>Ada.Numerics;" - :type 'integer :group 'ada) - -(defcustom ada-when-indent 3 - "Indentation for `when' relative to `exception' or `case'. - -An example is: - case A is - >>>>when B =>" - :type 'integer :group 'ada) - -(defcustom ada-with-indent ada-broken-indent - "Indentation for the lines in a `with' statement. - -An example is: - with Ada.Text_IO, - >>>>Ada.Numerics;" - :type 'integer :group 'ada) - -(defcustom ada-which-compiler 'gnat - "Name of the compiler to use. -This will determine what features are made available through the Ada mode. -The possible choices are: -`gnat': Use Ada Core Technologies' GNAT compiler. Add some cross-referencing - features. -`generic': Use a generic compiler." - :type '(choice (const gnat) - (const generic)) - :group 'ada) - - -;;; ---- end of user configurable variables - - -(defvar ada-body-suffixes '(".adb") - "List of possible suffixes for Ada body files. -The extensions should include a `.' if needed.") - -(defvar ada-spec-suffixes '(".ads") - "List of possible suffixes for Ada spec files. -The extensions should include a `.' if needed.") - -(defvar ada-mode-menu (make-sparse-keymap "Ada") - "Menu for Ada mode.") - -(defvar ada-mode-map (make-sparse-keymap) - "Local keymap used for Ada mode.") - -(defvar ada-mode-extra-map (make-sparse-keymap) - "Keymap used for non-standard keybindings.") - -;; default is C-c C-q because it's free in ada-mode-map -(defvar ada-mode-extra-prefix "\C-c\C-q" - "Prefix key to access `ada-mode-extra-map' functions.") - -(define-abbrev-table 'ada-mode-abbrev-table () - "Local abbrev table for Ada mode.") - -(eval-when-compile - ;; These values are used in eval-when-compile expressions. - (defconst ada-83-string-keywords - '("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin" - "body" "case" "constant" "declare" "delay" "delta" "digits" "do" - "else" "elsif" "end" "entry" "exception" "exit" "for" "function" - "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new" - "not" "null" "of" "or" "others" "out" "package" "pragma" "private" - "procedure" "raise" "range" "record" "rem" "renames" "return" - "reverse" "select" "separate" "subtype" "task" "terminate" "then" - "type" "use" "when" "while" "with" "xor") - "List of Ada 83 keywords. -Used to define `ada-*-keywords'.") - - (defconst ada-95-string-keywords - '("abstract" "aliased" "protected" "requeue" "tagged" "until") - "List of keywords new in Ada 95. -Used to define `ada-*-keywords'.") - - (defconst ada-2005-string-keywords - '("interface" "overriding" "synchronized") - "List of keywords new in Ada 2005. -Used to define `ada-*-keywords.'")) - -(defvar ada-ret-binding nil - "Variable to save key binding of RET when casing is activated.") - -(defvar ada-case-exception '() - "Alist of words (entities) that have special casing.") - -(defvar ada-case-exception-substring '() - "Alist of substrings (entities) that have special casing. -The substrings are detected for word constituent when the word -is not itself in `ada-case-exception', and only for substrings that -either are at the beginning or end of the word, or start after `_'.") - -(defvar ada-lfd-binding nil - "Variable to save key binding of LFD when casing is activated.") - -(defvar ada-other-file-alist nil - "Variable used by `find-file' to find the name of the other package. -See `ff-other-file-alist'.") - -(defvar ada-align-list - '(("[^:]\\(\\s-*\\):[^:]" 1 t) - ("[^=]\\(\\s-+\\)=[^=]" 1 t) - ("\\(\\s-*\\)use\\s-" 1) - ("\\(\\s-*\\)--" 1)) - "Ada support for align.el <= 2.2. -This variable provides regular expressions on which to align different lines. -See `align-mode-alist' for more information.") - -(defvar ada-align-modes - '((ada-declaration - (regexp . "[^:]\\(\\s-*\\):[^:]") - (valid . (lambda() (not (ada-in-comment-p)))) - (modes . '(ada-mode))) - (ada-assignment - (regexp . "[^=]\\(\\s-+\\)=[^=]") - (valid . (lambda() (not (ada-in-comment-p)))) - (modes . '(ada-mode))) - (ada-comment - (regexp . "\\(\\s-*\\)--") - (modes . '(ada-mode))) - (ada-use - (regexp . "\\(\\s-*\\)use\\s-") - (valid . (lambda() (not (ada-in-comment-p)))) - (modes . '(ada-mode))) - ) - "Ada support for align.el >= 2.8. -This variable defines several rules to use to align different lines.") - -(defconst ada-align-region-separate - (eval-when-compile - (concat - "^\\s-*\\($\\|\\(" - "begin\\|" - "declare\\|" - "else\\|" - "end\\|" - "exception\\|" - "for\\|" - "function\\|" - "generic\\|" - "if\\|" - "is\\|" - "procedure\\|" - "record\\|" - "return\\|" - "type\\|" - "when" - "\\)\\>\\)")) - "See the variable `align-region-separate' for more information.") - -;;; ---- Below are the regexp used in this package for parsing - -(defconst ada-83-keywords - (eval-when-compile - (concat "\\<" (regexp-opt ada-83-string-keywords t) "\\>")) - "Regular expression matching Ada83 keywords.") - -(defconst ada-95-keywords - (eval-when-compile - (concat "\\<" (regexp-opt - (append - ada-95-string-keywords - ada-83-string-keywords) t) "\\>")) - "Regular expression matching Ada95 keywords.") - -(defconst ada-2005-keywords - (eval-when-compile - (concat "\\<" (regexp-opt - (append - ada-2005-string-keywords - ada-83-string-keywords - ada-95-string-keywords) t) "\\>")) - "Regular expression matching Ada2005 keywords.") - -(defvar ada-keywords ada-2005-keywords - "Regular expression matching Ada keywords.") -;; FIXME: make this customizable - -(defconst ada-ident-re - "[[:alpha:]]\\(?:[_[:alnum:]]\\)*" - ;; [:alnum:] matches any multibyte word constituent, as well as - ;; Latin-1 letters and numbers. This allows __ and trailing _; - ;; someone (emacs bug#1919) proposed [^\W_] to fix that, but \W does - ;; _not_ mean "not word constituent" inside a character alternative. - "Regexp matching an Ada identifier.") - -(defconst ada-goto-label-re - (concat "<<" ada-ident-re ">>") - "Regexp matching a goto label.") - -(defconst ada-block-label-re - (concat ada-ident-re "[ \t\n]*:[^=]") - "Regexp matching a block label. -Note that this also matches a variable declaration.") - -(defconst ada-label-re - (concat "\\(?:" ada-block-label-re "\\)\\|\\(?:" ada-goto-label-re "\\)") - "Regexp matching a goto or block label.") - -;; "with" needs to be included in the regexp, to match generic subprogram parameters -;; Similarly, we put '[not] overriding' on the same line with 'procedure' etc. -(defvar ada-procedure-start-regexp - (concat - "^[ \t]*\\(with[ \t]+\\)?\\(\\(not[ \t]+\\)?overriding[ \t]+\\)?\\(procedure\\|function\\|task\\)[ \t\n]+" - - ;; subprogram name: operator ("[+/=*]") - "\\(" - "\\(\"[^\"]+\"\\)" - - ;; subprogram name: name - "\\|" - "\\(\\(\\sw\\|[_.]\\)+\\)" - "\\)") - "Regexp matching Ada subprogram start. -The actual start is at (match-beginning 4). The name is in (match-string 5).") - -(defconst ada-name-regexp - "\\([a-zA-Z][a-zA-Z0-9_.']*[a-zA-Z0-9]\\)" - "Regexp matching a fully qualified name (including attribute).") - -(defconst ada-package-start-regexp - (concat "^[ \t]*\\(private[ \t]+\\)?\\(package\\)[ \t\n]+\\(body[ \t]*\\)?" ada-name-regexp) - "Regexp matching start of package. -The package name is in (match-string 4).") - -(defconst ada-compile-goto-error-file-linenr-re - "\\([-_.a-zA-Z0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?" - "Regexp matching filename:linenr[:column].") - - -;;; ---- regexps for indentation functions - -(defvar ada-block-start-re - (eval-when-compile - (concat "\\<\\(" (regexp-opt '("begin" "declare" "else" - "exception" "generic" "loop" "or" - "private" "select" )) - "\\|\\(\\(limited\\|abstract\\|tagged\\)[ \t\n]+\\)*record\\)\\>")) - "Regexp for keywords starting Ada blocks.") - -(defvar ada-end-stmt-re - (eval-when-compile - (concat "\\(" - ";" "\\|" - "=>[ \t]*$" "\\|" - "=>[ \t]*--.*$" "\\|" - "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)" "\\|" - "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic" - "loop" "private" "record" "select" - "then abort" "then") t) "\\>" "\\|" - "^[ \t]*" (regexp-opt '("function" "package" "procedure") - t) "\\>\\(\\sw\\|[ \t_.]\\)+\\" "\\|" - "^[ \t]*exception\\>" - "\\)") ) - "Regexp of possible ends for a non-broken statement. -A new statement starts after these.") - -(defvar ada-matching-start-re - (eval-when-compile - (concat "\\<" - (regexp-opt - '("end" "loop" "select" "begin" "case" "do" "declare" - "if" "task" "package" "procedure" "function" "record" "protected") t) - "\\>")) - "Regexp used in `ada-goto-matching-start'.") - -(defvar ada-loop-start-re - "\\<\\(for\\|while\\|loop\\)\\>" - "Regexp for the start of a loop.") - -(defvar ada-subprog-start-re - (eval-when-compile - (concat "\\<" (regexp-opt '("accept" "entry" "function" "overriding" "package" "procedure" - "protected" "task") t) "\\>")) - "Regexp for the start of a subprogram.") - -(defvar ada-contextual-menu-on-identifier nil - "Set to true when the right mouse button was clicked on an identifier.") - -(defvar ada-contextual-menu-last-point nil - "Position of point just before displaying the menu. -This is a list (point buffer). -Since `ada-popup-menu' moves the point where the user clicked, the region -is modified. Therefore no command from the menu knows what the user selected -before displaying the contextual menu. -To get the original region, restore the point to this position before -calling `region-end' and `region-beginning'. -Modify this variable if you want to restore the point to another position.") - -(easy-menu-define ada-contextual-menu nil - "Menu to use when the user presses the right mouse button. -The variable `ada-contextual-menu-on-identifier' will be set to t before -displaying the menu if point was on an identifier." - '("Ada" - ["Goto Declaration/Body" ada-point-and-xref - :included ada-contextual-menu-on-identifier] - ["Goto Body" ada-point-and-xref-body - :included ada-contextual-menu-on-identifier] - ["Goto Previous Reference" ada-xref-goto-previous-reference] - ["List References" ada-find-references - :included ada-contextual-menu-on-identifier] - ["List Local References" ada-find-local-references - :included ada-contextual-menu-on-identifier] - ["-" nil nil] - ["Other File" ff-find-other-file] - ["Goto Parent Unit" ada-goto-parent])) - - -;;------------------------------------------------------------------ -;; Support for imenu (see imenu.el) -;;------------------------------------------------------------------ - -(defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?") - -(defconst ada-imenu-subprogram-menu-re - (concat "^[ \t]*\\(overriding[ \t]*\\)?\\(procedure\\|function\\)[ \t\n]+" - "\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)" - ada-imenu-comment-re - "\\)[ \t\n]*" - "\\(return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?is[ \t\n]")) - -(defvar ada-imenu-generic-expression - (list - (list nil ada-imenu-subprogram-menu-re 3) - (list "*Specs*" - (concat - "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)" - "\\(" - "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)" - ada-imenu-comment-re "\\)";; parameter list or simple space - "\\([ \t\n]*return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?" - "\\)?;") 2) - '("*Tasks*" "^[ \t]*task[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2) - '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2) - '("*Protected*" - "^[ \t]*protected[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2) - '("*Packages*" "^[ \t]*package[ \t]+\\(\\(body[ \t]+\\)?\\(\\sw\\|[_.]\\)+\\)" 1)) - "Imenu generic expression for Ada mode. -See `imenu-generic-expression'. This variable will create several submenus for -each type of entity that can be found in an Ada file.") - - -;;------------------------------------------------------------ -;; Support for compile.el -;;------------------------------------------------------------ - -(defun ada-compile-mouse-goto-error () - "Mouse interface for `ada-compile-goto-error'." - (interactive) - (mouse-set-point last-input-event) - (ada-compile-goto-error (point)) - ) - -(defun ada-compile-goto-error (pos) - "Replace `compile-goto-error' from compile.el. -If POS is on a file and line location, go to this position. It adds -to compile.el the capacity to go to a reference in an error message. -For instance, on these lines: - foo.adb:61:11: [...] in call to size declared at foo.ads:11 - foo.adb:61:11: [...] in call to local declared at line 20 -the 4 file locations can be clicked on and jumped to." - (interactive "d") - (goto-char pos) - - (skip-chars-backward "-a-zA-Z0-9_:./\\\\") - (cond - ;; special case: looking at a filename:line not at the beginning of a line - ;; or a simple line reference "at line ..." - ((and (not (bolp)) - (or (looking-at ada-compile-goto-error-file-linenr-re) - (and - (save-excursion - (beginning-of-line) - (looking-at ada-compile-goto-error-file-linenr-re)) - (save-excursion - (if (looking-at "\\([0-9]+\\)") (backward-word-strictly 1)) - (looking-at "line \\([0-9]+\\)")))) - ) - (let ((line (if (match-beginning 2) (match-string 2) (match-string 1))) - (file (if (match-beginning 2) (match-string 1) - (save-excursion (beginning-of-line) - (looking-at ada-compile-goto-error-file-linenr-re) - (match-string 1)))) - (error-pos (point-marker)) - source) - - ;; set source marker - (save-excursion - (compilation-find-file (point-marker) (match-string 1) "./") - (set-buffer file) - - (when (stringp line) - (goto-char (point-min)) - (forward-line (1- (string-to-number line)))) - - (setq source (point-marker))) - - (compilation-goto-locus error-pos source nil) - - )) - - ;; otherwise, default behavior - (t - (compile-goto-error)) - ) - (recenter)) - - -;;------------------------------------------------------------------------- -;; Grammar related function -;; The functions below work with the syntax class of the characters in an Ada -;; buffer. Two syntax tables are created, depending on whether we want '_' -;; to be considered as part of a word or not. -;; Some characters may have multiple meanings depending on the context: -;; - ' is either the beginning of a constant character or an attribute -;; - # is either part of a based literal or a gnatprep statement. -;; - " starts a string, but not if inside a constant character. -;; - ( and ) should be ignored if inside a constant character. -;; Thus their syntax property is changed automatically, and we can still use -;; the standard Emacs functions for sexp (see `ada-in-string-p') -;; -;; On Emacs, this is done through the `syntax-table' text property. The -;; corresponding action is applied automatically each time the buffer -;; changes via syntax-propertize-function. -;; -;; on XEmacs, the `syntax-table' property does not exist and we have to use a -;; slow advice to `parse-partial-sexp' to do the same thing. -;; When executing parse-partial-sexp, we simply modify the strings before and -;; after, so that the special constants '"', '(' and ')' do not interact -;; with parse-partial-sexp. -;; Note: this code is slow and needs to be rewritten as soon as something -;; better is available on XEmacs. -;;------------------------------------------------------------------------- - -(defvar ada-mode-syntax-table - (let ((st (make-syntax-table))) - ;; Define string brackets (`%' is alternative string bracket, but - ;; almost never used as such and throws font-lock and indentation - ;; off the track.) - (modify-syntax-entry ?% "$" st) - (modify-syntax-entry ?\" "\"" st) - - (modify-syntax-entry ?: "." st) - (modify-syntax-entry ?\; "." st) - (modify-syntax-entry ?& "." st) - (modify-syntax-entry ?\| "." st) - (modify-syntax-entry ?+ "." st) - (modify-syntax-entry ?* "." st) - (modify-syntax-entry ?/ "." st) - (modify-syntax-entry ?= "." st) - (modify-syntax-entry ?< "." st) - (modify-syntax-entry ?> "." st) - (modify-syntax-entry ?$ "." st) - (modify-syntax-entry ?\[ "." st) - (modify-syntax-entry ?\] "." st) - (modify-syntax-entry ?\{ "." st) - (modify-syntax-entry ?\} "." st) - (modify-syntax-entry ?. "." st) - (modify-syntax-entry ?\\ "." st) - (modify-syntax-entry ?\' "." st) - - ;; A single hyphen is punctuation, but a double hyphen starts a comment. - (modify-syntax-entry ?- ". 12" st) - - ;; See the comment above on grammar related function for the special - ;; setup for '#'. - (modify-syntax-entry ?# (if (featurep 'xemacs) "<" "$") st) - - ;; And \f and \n end a comment. - (modify-syntax-entry ?\f "> " st) - (modify-syntax-entry ?\n "> " st) - - ;; Define what belongs in Ada symbols. - (modify-syntax-entry ?_ "_" st) - - ;; Define parentheses to match. - (modify-syntax-entry ?\( "()" st) - (modify-syntax-entry ?\) ")(" st) - st) - "Syntax table to be used for editing Ada source code.") - -(defvar ada-mode-symbol-syntax-table - (let ((st (make-syntax-table ada-mode-syntax-table))) - (modify-syntax-entry ?_ "w" st) - st) - "Syntax table for Ada, where `_' is a word constituent.") - -;; Support of special characters in XEmacs (see the comments at the beginning -;; of the section on Grammar related functions). - -(if (featurep 'xemacs) - (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants) - "Handles special character constants and gnatprep statements." - (let (change) - (if (< to from) - (let ((tmp from)) - (setq from to to tmp))) - (save-excursion - (goto-char from) - (while (re-search-forward "'\\([(\")#]\\)'" to t) - (setq change (cons (list (match-beginning 1) - 1 - (match-string 1)) - change)) - (replace-match "'A'")) - (goto-char from) - (while (re-search-forward "\\(#[[:xdigit:]]*#\\)" to t) - (setq change (cons (list (match-beginning 1) - (length (match-string 1)) - (match-string 1)) - change)) - (replace-match (make-string (length (match-string 1)) ?@)))) - ad-do-it - (save-excursion - (while change - (goto-char (caar change)) - (delete-char (cadar change)) - (insert (caddar change)) - (setq change (cdr change))))))) - -(unless (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) - ;; Before `syntax-propertize', we had to use font-lock to apply syntax-table - ;; properties, and in some cases we even had to do it manually (in - ;; `ada-after-change-function'). `ada-handle-syntax-table-properties' - ;; decides which method to use. - -(defun ada-set-syntax-table-properties () - "Assign `syntax-table' properties in accessible part of buffer. -In particular, character constants are said to be strings, #...# -are treated as numbers instead of gnatprep comments." - (let ((modified (buffer-modified-p)) - (buffer-undo-list t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t)) - (remove-text-properties (point-min) (point-max) '(syntax-table nil)) - (goto-char (point-min)) - (while (re-search-forward - ;; The following regexp was adapted from - ;; `ada-font-lock-syntactic-keywords'. - "^[ \t]*\\(#\\(?:if\\|else\\|elsif\\|end\\)\\)\\|[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" - nil t) - (if (match-beginning 1) - (put-text-property - (match-beginning 1) (match-end 1) 'syntax-table '(11 . ?\n)) - (put-text-property - (match-beginning 2) (match-end 2) 'syntax-table '(7 . ?')) - (put-text-property - (match-beginning 3) (match-end 3) 'syntax-table '(7 . ?')))) - (unless modified - (restore-buffer-modified-p nil)))) - -(defun ada-after-change-function (beg end _old-len) - "Called when the region between BEG and END was changed in the buffer. -OLD-LEN indicates what the length of the replaced text was." - (save-excursion - (save-restriction - (let ((from (progn (goto-char beg) (line-beginning-position))) - (to (progn (goto-char end) (line-end-position)))) - (narrow-to-region from to) - (save-match-data - (ada-set-syntax-table-properties)))))) - -(defun ada-initialize-syntax-table-properties () - "Assign `syntax-table' properties in current buffer." - (save-excursion - (save-restriction - (widen) - (save-match-data - (ada-set-syntax-table-properties)))) - (add-hook 'after-change-functions 'ada-after-change-function nil t)) - -(defun ada-handle-syntax-table-properties () - "Handle `syntax-table' properties." - (if font-lock-mode - ;; `font-lock-mode' will take care of `syntax-table' properties. - (remove-hook 'after-change-functions 'ada-after-change-function t) - ;; Take care of `syntax-table' properties manually. - (ada-initialize-syntax-table-properties))) - -) ;;(not (fboundp 'syntax-propertize)) - -;;------------------------------------------------------------------ -;; Testing the grammatical context -;;------------------------------------------------------------------ - -(defsubst ada-in-comment-p (&optional parse-result) - "Return t if inside a comment. -If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'." - (nth 4 (or parse-result - (parse-partial-sexp - (line-beginning-position) (point))))) - -(defsubst ada-in-string-p (&optional parse-result) - "Return t if point is inside a string. -If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'." - (nth 3 (or parse-result - (parse-partial-sexp - (line-beginning-position) (point))))) - -(defsubst ada-in-string-or-comment-p (&optional parse-result) - "Return t if inside a comment or string. -If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'." - (setq parse-result (or parse-result - (parse-partial-sexp - (line-beginning-position) (point)))) - (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result))) - -(defsubst ada-in-numeric-literal-p () - "Return t if point is after a prefix of a numeric literal." - (looking-back "\\([0-9]+#[[:xdigit:]_]+\\)" (line-beginning-position))) - -;;------------------------------------------------------------------ -;; Contextual menus -;; The Ada mode comes with contextual menus, bound by default to the right -;; mouse button. -;; Add items to this menu by modifying `ada-contextual-menu'. Note that the -;; variable `ada-contextual-menu-on-identifier' is set automatically to t -;; if the mouse button was pressed on an identifier. -;;------------------------------------------------------------------ - -(defun ada-call-from-contextual-menu (function) - "Execute FUNCTION when called from the contextual menu. -It forces Emacs to change the cursor position." - (interactive) - (funcall function) - (setq ada-contextual-menu-last-point - (list (point) (current-buffer)))) - -(defun ada-popup-menu (position) - "Pops up a contextual menu, depending on where the user clicked. -POSITION is the location the mouse was clicked on. -Sets `ada-contextual-menu-last-point' to the current position before -displaying the menu. When a function from the menu is called, the -point is where the mouse button was clicked." - (interactive "e") - - ;; declare this as a local variable, so that the function called - ;; in the contextual menu does not hide the region in - ;; transient-mark-mode. - (let ((deactivate-mark nil)) - (setq ada-contextual-menu-last-point - (list (point) (current-buffer))) - (mouse-set-point last-input-event) - - (setq ada-contextual-menu-on-identifier - (and (char-after) - (or (= (char-syntax (char-after)) ?w) - (= (char-after) ?_)) - (not (ada-in-string-or-comment-p)) - (save-excursion (skip-syntax-forward "w") - (not (ada-after-keyword-p))) - )) - (if (fboundp 'popup-menu) - (funcall (symbol-function 'popup-menu) ada-contextual-menu) - (let (choice) - (setq choice (x-popup-menu position ada-contextual-menu)) - (if choice - (funcall (lookup-key ada-contextual-menu (vector (car choice))))))) - - (set-buffer (cadr ada-contextual-menu-last-point)) - (goto-char (car ada-contextual-menu-last-point)) - )) - - -;;------------------------------------------------------------------ -;; Misc functions -;;------------------------------------------------------------------ - -;;;###autoload -(defun ada-add-extensions (spec body) - "Define SPEC and BODY as being valid extensions for Ada files. -Going from body to spec with `ff-find-other-file' used these -extensions. -SPEC and BODY are two regular expressions that must match against -the file name." - (let* ((reg (concat (regexp-quote body) "$")) - (tmp (assoc reg ada-other-file-alist))) - (if tmp - (setcdr tmp (list (cons spec (cadr tmp)))) - (add-to-list 'ada-other-file-alist (list reg (list spec))))) - - (let* ((reg (concat (regexp-quote spec) "$")) - (tmp (assoc reg ada-other-file-alist))) - (if tmp - (setcdr tmp (list (cons body (cadr tmp)))) - (add-to-list 'ada-other-file-alist (list reg (list body))))) - - (add-to-list 'auto-mode-alist - (cons (concat (regexp-quote spec) "\\'") 'ada-mode)) - (add-to-list 'auto-mode-alist - (cons (concat (regexp-quote body) "\\'") 'ada-mode)) - - (add-to-list 'ada-spec-suffixes spec) - (add-to-list 'ada-body-suffixes body) - - ;; Support for speedbar (Specifies that we want to see these files in - ;; speedbar) - (if (fboundp 'speedbar-add-supported-extension) - (progn - (funcall (symbol-function 'speedbar-add-supported-extension) - spec) - (funcall (symbol-function 'speedbar-add-supported-extension) - body)))) - -(defvar ada-font-lock-syntactic-keywords) ; defined below - -;;;###autoload -(define-derived-mode ada-mode prog-mode "Ada" - "Ada mode is the major mode for editing Ada code." - - ;; Set the paragraph delimiters so that one can select a whole block - ;; simply with M-h - (set (make-local-variable 'paragraph-start) "[ \t\n\f]*$") - (set (make-local-variable 'paragraph-separate) "[ \t\n\f]*$") - - ;; comment end must be set because it may hold a wrong value if - ;; this buffer had been in another mode before. RE - (set (make-local-variable 'comment-end) "") - - ;; used by autofill and indent-new-comment-line - (set (make-local-variable 'comment-start-skip) "---*[ \t]*") - - ;; used by autofill to break a comment line and continue it on another line. - ;; The reason we need this one is that the default behavior does not work - ;; correctly with the definition of paragraph-start above when the comment - ;; is right after a multi-line subprogram declaration (the comments are - ;; aligned under the latest parameter, not under the declaration start). - (set (make-local-variable 'comment-line-break-function) - (lambda (&optional soft) (let ((fill-prefix nil)) - (indent-new-comment-line soft)))) - - (set (make-local-variable 'indent-line-function) - 'ada-indent-current-function) - - (set (make-local-variable 'comment-column) 40) - - ;; Emacs 20.3 defines a comment-padding to insert spaces between - ;; the comment and the text. We do not want any, this is already - ;; included in comment-start - (unless (featurep 'xemacs) - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'comment-padding) 0) - (set (make-local-variable 'parse-sexp-lookup-properties) t)) - - (setq case-fold-search t) - (if (boundp 'imenu-case-fold-search) - (setq imenu-case-fold-search t)) - - (set (make-local-variable 'fill-paragraph-function) - 'ada-fill-comment-paragraph) - - ;; Support for compile.el - ;; We just substitute our own functions to go to the error. - (add-hook 'compilation-mode-hook - (lambda() - ;; FIXME: This has global impact! -stef - (define-key compilation-minor-mode-map [mouse-2] - 'ada-compile-mouse-goto-error) - (define-key compilation-minor-mode-map "\C-c\C-c" - 'ada-compile-goto-error) - (define-key compilation-minor-mode-map "\C-m" - 'ada-compile-goto-error))) - - ;; font-lock support : - - (set (make-local-variable 'font-lock-defaults) - '(ada-font-lock-keywords - nil t - ((?\_ . "w") (?# . ".")) - beginning-of-line)) - - (if (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) - (set (make-local-variable 'syntax-propertize-function) - (syntax-propertize-via-font-lock ada-font-lock-syntactic-keywords)) - (set (make-local-variable 'font-lock-syntactic-keywords) - ada-font-lock-syntactic-keywords)) - - ;; Set up support for find-file.el. - (set (make-local-variable 'ff-other-file-alist) - 'ada-other-file-alist) - (set (make-local-variable 'ff-search-directories) - 'ada-search-directories-internal) - (setq ff-post-load-hook 'ada-set-point-accordingly - ff-file-created-hook 'ada-make-body) - (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in) - - (make-local-variable 'ff-special-constructs) - (mapc (lambda (pair) (add-to-list 'ff-special-constructs pair)) - (list - ;; Top level child package declaration; go to the parent package. - (cons (eval-when-compile - (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+" - "\\(body[ \t]+\\)?" - "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is")) - (lambda () - (ff-get-file - ada-search-directories-internal - (ada-make-filename-from-adaname (match-string 3)) - ada-spec-suffixes))) - - ;; A "separate" clause. - (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))" - (lambda () - (ff-get-file - ada-search-directories-internal - (ada-make-filename-from-adaname (match-string 1)) - ada-spec-suffixes))) - - ;; A "with" clause. - (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" - (lambda () - (ff-get-file - ada-search-directories-internal - (ada-make-filename-from-adaname (match-string 1)) - ada-spec-suffixes))) - )) - - ;; Support for outline-minor-mode - (set (make-local-variable 'outline-regexp) - "\\([ \t]*\\(procedure\\|function\\|package\\|if\\|while\\|for\\|declare\\|case\\|end\\|begin\\|loop\\)\\|--\\)") - (set (make-local-variable 'outline-level) 'ada-outline-level) - - ;; Support for imenu : We want a sorted index - (setq imenu-generic-expression ada-imenu-generic-expression) - - (setq imenu-sort-function 'imenu--sort-by-name) - - ;; Support for ispell : Check only comments - (set (make-local-variable 'ispell-check-comments) 'exclusive) - - ;; Support for align - (add-to-list 'align-dq-string-modes 'ada-mode) - (add-to-list 'align-open-comment-modes 'ada-mode) - (set (make-local-variable 'align-region-separate) ada-align-region-separate) - - ;; Exclude comments alone on line from alignment. - (add-to-list 'align-exclude-rules-list - '(ada-solo-comment - (regexp . "^\\(\\s-*\\)--") - (modes . '(ada-mode)))) - (add-to-list 'align-exclude-rules-list - '(ada-solo-use - (regexp . "^\\(\\s-*\\)\\") - (modes . '(ada-mode)))) - - (setq ada-align-modes nil) - - (add-to-list 'ada-align-modes - '(ada-declaration-assign - (regexp . "[^:]\\(\\s-*\\):[^:]") - (valid . (lambda() (not (ada-in-comment-p)))) - (repeat . t) - (modes . '(ada-mode)))) - (add-to-list 'ada-align-modes - '(ada-associate - (regexp . "[^=]\\(\\s-*\\)=>") - (valid . (lambda() (not (ada-in-comment-p)))) - (modes . '(ada-mode)))) - (add-to-list 'ada-align-modes - '(ada-comment - (regexp . "\\(\\s-*\\)--") - (modes . '(ada-mode)))) - (add-to-list 'ada-align-modes - '(ada-use - (regexp . "\\(\\s-*\\)\\") - (modes . '(ada-mode)))) - - (setq align-mode-rules-list ada-align-modes) - - ;; Set up the contextual menu - (if ada-popup-key - (define-key ada-mode-map ada-popup-key 'ada-popup-menu)) - - ;; Support for Abbreviations (the user still needs to "M-x abbrev-mode"). - (setq local-abbrev-table ada-mode-abbrev-table) - - ;; Support for which-function mode - (set (make-local-variable 'which-func-functions) '(ada-which-function)) - - ;; Support for indent-new-comment-line (Especially for XEmacs) - (set (make-local-variable 'comment-multi-line) nil) - - ;; Support for add-log - (set (make-local-variable 'add-log-current-defun-function) - 'ada-which-function) - - (easy-menu-add ada-mode-menu ada-mode-map) - - (set (make-local-variable 'skeleton-further-elements) - '((< '(backward-delete-char-untabify - (min ada-indent (current-column)))))) - (add-hook 'skeleton-end-hook 'ada-adjust-case-skeleton nil t) - - ;; To be run after the hook, in case the user modified - ;; ada-fill-comment-prefix - (add-hook 'hack-local-variables-hook - (lambda () - (set (make-local-variable 'comment-start) - (or ada-fill-comment-prefix "-- ")) - - ;; Run this after the hook to give the users a chance - ;; to activate font-lock-mode. - - (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) - (featurep 'xemacs)) - (ada-initialize-syntax-table-properties) - (add-hook 'font-lock-mode-hook - 'ada-handle-syntax-table-properties nil t)) - - ;; FIXME: ada-language-version might be set in the mode - ;; hook or it might even be set later on via file-local - ;; vars, so ada-keywords should be set lazily. - (cond ((eq ada-language-version 'ada83) - (setq ada-keywords ada-83-keywords)) - ((eq ada-language-version 'ada95) - (setq ada-keywords ada-95-keywords)) - ((eq ada-language-version 'ada2005) - (setq ada-keywords ada-2005-keywords))) - - (if ada-auto-case - (ada-activate-keys-for-case))) - nil 'local)) - -(defun ada-adjust-case-skeleton () - "Adjust the case of the text inserted by a skeleton." - (save-excursion - (let ((aa-end (point))) - (ada-adjust-case-region - (progn (goto-char (symbol-value 'beg)) (forward-word-strictly -1) - (point)) - (goto-char aa-end))))) - -(defun ada-region-selected () - "Should we operate on an active region?" - (if (fboundp 'use-region-p) - (use-region-p) - (region-active-p))) - -;;----------------------------------------------------------------- -;; auto-casing -;; Since Ada is case-insensitive, the Ada mode provides an extensive set of -;; functions to auto-case identifiers, keywords, ... -;; The basic rules for autocasing are defined through the variables -;; `ada-case-attribute', `ada-case-keyword' and `ada-case-identifier'. These -;; are references to the functions that will do the actual casing. -;; -;; However, in most cases, the user will want to define some exceptions to -;; these casing rules. This is done through a list of files, that contain -;; one word per line. These files are stored in `ada-case-exception-file'. -;; For backward compatibility, this variable can also be a string. -;;----------------------------------------------------------------- - -(defun ada-save-exceptions-to-file (file-name) - "Save the casing exception lists to the file FILE-NAME. -Casing exception lists are `ada-case-exception' and `ada-case-exception-substring'." - (find-file (expand-file-name file-name)) - (erase-buffer) - (mapc (lambda (x) (insert (car x) "\n")) - (sort (copy-sequence ada-case-exception) - (lambda(a b) (string< (car a) (car b))))) - (mapc (lambda (x) (insert "*" (car x) "\n")) - (sort (copy-sequence ada-case-exception-substring) - (lambda(a b) (string< (car a) (car b))))) - (save-buffer) - (kill-buffer nil) - ) - -(defun ada-create-case-exception (&optional word) - "Define WORD as an exception for the casing system. -If WORD is not given, then the current word in the buffer is used instead. -The new word is added to the first file in `ada-case-exception-file'. -The standard casing rules will no longer apply to this word." - (interactive) - (let ((file-name - (cond ((stringp ada-case-exception-file) - ada-case-exception-file) - ((listp ada-case-exception-file) - (car ada-case-exception-file)) - (t - (error (concat "No exception file specified. " - "See variable ada-case-exception-file")))))) - - (unless word - (with-syntax-table ada-mode-symbol-syntax-table - (save-excursion - (skip-syntax-backward "w") - (setq word (buffer-substring-no-properties - (point) (save-excursion (forward-word-strictly 1) - (point))))))) - - ;; Reread the exceptions file, in case it was modified by some other, - (ada-case-read-exceptions-from-file file-name) - - ;; If the word is already in the list, even with a different casing - ;; we simply want to replace it. - (if (and (not (equal ada-case-exception '())) - (assoc-string word ada-case-exception t)) - (setcar (assoc-string word ada-case-exception t) word) - (add-to-list 'ada-case-exception (cons word t))) - - (ada-save-exceptions-to-file file-name))) - -(defun ada-create-case-exception-substring (&optional word) - "Define the substring WORD as an exception for the casing system. -If WORD is not given, then the current word in the buffer is used instead, -or the selected region if any is active. -The new word is added to the first file in `ada-case-exception-file'. -When auto-casing a word, this substring will be special-cased, unless the -word itself has a special casing." - (interactive) - (let ((file-name - (cond ((stringp ada-case-exception-file) - ada-case-exception-file) - ((listp ada-case-exception-file) - (car ada-case-exception-file)) - (t - (error (concat "No exception file specified. " - "See variable ada-case-exception-file")))))) - - ;; Find the substring to define as an exception. Order is: the parameter, - ;; if any, or the selected region, or the word under the cursor - (cond - (word nil) - - ((ada-region-selected) - (setq word (buffer-substring-no-properties - (region-beginning) (region-end)))) - - (t - (let ((underscore-syntax (char-syntax ?_))) - (unwind-protect - (progn - (modify-syntax-entry ?_ "." (syntax-table)) - (save-excursion - (skip-syntax-backward "w") - (setq word (buffer-substring-no-properties - (point) - (save-excursion (forward-word-strictly 1) - (point)))))) - (modify-syntax-entry ?_ (make-string 1 underscore-syntax) - (syntax-table)))))) - - ;; Reread the exceptions file, in case it was modified by some other, - (ada-case-read-exceptions-from-file file-name) - - ;; If the word is already in the list, even with a different casing - ;; we simply want to replace it. - (if (and (not (equal ada-case-exception-substring '())) - (assoc-string word ada-case-exception-substring t)) - (setcar (assoc-string word ada-case-exception-substring t) word) - (add-to-list 'ada-case-exception-substring (cons word t)) - ) - - (ada-save-exceptions-to-file file-name) - - (message "%s" (concat "Defining " word " as a casing exception")))) - -(defun ada-case-read-exceptions-from-file (file-name) - "Read the content of the casing exception file FILE-NAME." - (if (file-readable-p (expand-file-name file-name)) - (let ((buffer (current-buffer))) - (find-file (expand-file-name file-name)) - (set-syntax-table ada-mode-symbol-syntax-table) - (widen) - (goto-char (point-min)) - (while (not (eobp)) - - ;; If the item is already in the list, even with an other casing, - ;; do not add it again. This way, the user can easily decide which - ;; priority should be applied to each casing exception - (let ((word (buffer-substring-no-properties - (point) (save-excursion (forward-word-strictly 1) - (point))))) - - ;; Handling a substring ? - (if (char-equal (string-to-char word) ?*) - (progn - (setq word (substring word 1)) - (unless (assoc-string word ada-case-exception-substring t) - (add-to-list 'ada-case-exception-substring (cons word t)))) - (unless (assoc-string word ada-case-exception t) - (add-to-list 'ada-case-exception (cons word t))))) - - (forward-line 1)) - (kill-buffer nil) - (set-buffer buffer))) - ) - -(defun ada-case-read-exceptions () - "Read all the casing exception files from `ada-case-exception-file'." - (interactive) - - ;; Reinitialize the casing exception list - (setq ada-case-exception '() - ada-case-exception-substring '()) - - (cond ((stringp ada-case-exception-file) - (ada-case-read-exceptions-from-file ada-case-exception-file)) - - ((listp ada-case-exception-file) - (mapcar 'ada-case-read-exceptions-from-file - ada-case-exception-file)))) - -(defun ada-adjust-case-substring () - "Adjust case of substrings in the previous word." - (interactive) - (let ((substrings ada-case-exception-substring) - (max (point)) - (case-fold-search t) - (underscore-syntax (char-syntax ?_)) - re) - - (save-excursion - (forward-word -1) - - (unwind-protect - (progn - (modify-syntax-entry ?_ "." (syntax-table)) - - (while substrings - (setq re (concat "\\b" (regexp-quote (caar substrings)) "\\b")) - - (save-excursion - (while (re-search-forward re max t) - (replace-match (caar substrings) t))) - (setq substrings (cdr substrings)) - ) - ) - (modify-syntax-entry ?_ (make-string 1 underscore-syntax) (syntax-table))) - ))) - -(defun ada-adjust-case-identifier () - "Adjust case of the previous identifier. -The auto-casing is done according to the value of `ada-case-identifier' -and the exceptions defined in `ada-case-exception-file'." - (interactive) - (if (or (equal ada-case-exception '()) - (equal (char-after) ?_)) - (progn - (funcall ada-case-identifier -1) - (ada-adjust-case-substring)) - - (progn - (let ((end (point)) - (start (save-excursion (skip-syntax-backward "w") - (point))) - match) - ;; If we have an exception, replace the word by the correct casing - (if (setq match (assoc-string (buffer-substring start end) - ada-case-exception t)) - - (progn - (delete-region start end) - (insert (car match))) - - ;; Else simply re-case the word - (funcall ada-case-identifier -1) - (ada-adjust-case-substring)))))) - -(defun ada-after-keyword-p () - "Return t if cursor is after a keyword that is not an attribute." - (save-excursion - (forward-word-strictly -1) - (and (not (and (char-before) - (or (= (char-before) ?_) - (= (char-before) ?'))));; unless we have a _ or ' - (looking-at (concat ada-keywords "[^_]"))))) - -(defun ada-adjust-case (&optional force-identifier) - "Adjust the case of the word before the character just typed. -If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." - (if (not (bobp)) - (progn - (forward-char -1) - (if (and (not (bobp)) - ;; or if at the end of a character constant - (not (and (eq (following-char) ?') - (eq (char-before (1- (point))) ?'))) - ;; or if the previous character was not part of a word - (eq (char-syntax (char-before)) ?w) - ;; if in a string or a comment - (not (ada-in-string-or-comment-p)) - ;; if in a numeric literal - (not (ada-in-numeric-literal-p)) - ) - (if (save-excursion - (forward-word -1) - (or (= (point) (point-min)) - (backward-char 1)) - (= (following-char) ?')) - (funcall ada-case-attribute -1) - (if (and - (not force-identifier) ; (MH) - (ada-after-keyword-p)) - (funcall ada-case-keyword -1) - (ada-adjust-case-identifier)))) - (forward-char 1) - )) - ) - -(defun ada-adjust-case-interactive (arg) - "Adjust the case of the previous word, and process the character just typed. -ARG is the prefix the user entered with \\[universal-argument]." - (interactive "P") - - (if ada-auto-case - (let ((lastk last-command-event)) - - (with-syntax-table ada-mode-symbol-syntax-table - (cond ((memq lastk '(?\n ?\r)) - ;; Horrible kludge. - (insert " ") - (ada-adjust-case) - ;; horrible dekludge - (delete-char -1) - ;; some special keys and their bindings - (cond - ((eq lastk ?\n) - (funcall ada-lfd-binding)) - ((eq lastk ?\r) - (funcall ada-ret-binding)))) - ((eq lastk ?\C-i) (ada-tab)) - ;; Else just insert the character - ((self-insert-command (prefix-numeric-value arg)))) - ;; if there is a keyword in front of the underscore - ;; then it should be part of an identifier (MH) - (if (eq lastk ?_) - (ada-adjust-case t) - (ada-adjust-case)))) - - ;; Else, no auto-casing - (cond - ((eq last-command-event ?\n) - (funcall ada-lfd-binding)) - ((eq last-command-event ?\r) - (funcall ada-ret-binding)) - (t - (self-insert-command (prefix-numeric-value arg)))))) - -(defun ada-activate-keys-for-case () - ;; FIXME: Use post-self-insert-hook instead of changing key bindings. - "Modify the key bindings for all the keys that should readjust the casing." - (interactive) - ;; Save original key-bindings to allow swapping ret/lfd - ;; when casing is activated. - ;; The 'or ...' is there to be sure that the value will not - ;; be changed again when Ada mode is called more than once - (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M"))) - (or ada-lfd-binding (setq ada-lfd-binding (key-binding "\C-j"))) - - ;; Call case modifying function after certain keys. - (mapcar (function (lambda(key) (define-key - ada-mode-map - (char-to-string key) - 'ada-adjust-case-interactive))) - '( ?` ?_ ?# ?% ?& ?* ?\( ?\) ?- ?= ?+ - ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))) - -(defun ada-loose-case-word (&optional _arg) - "Upcase first letter and letters following `_' in the following word. -No other letter is modified. -ARG is ignored, and is there for compatibility with `capitalize-word' only." - (interactive) - (save-excursion - (let ((end (save-excursion (skip-syntax-forward "w") (point))) - (first t)) - (skip-syntax-backward "w") - (while (and (or first (search-forward "_" end t)) - (< (point) end)) - (and first - (setq first nil)) - (insert-char (upcase (following-char)) 1) - (delete-char 1))))) - -(defun ada-no-auto-case (&optional _arg) - "Do nothing. ARG is ignored. -This function can be used for the auto-casing variables in Ada mode, to -adapt to unusual auto-casing schemes. Since it does nothing, you can for -instance use it for `ada-case-identifier' if you don't want any special -auto-casing for identifiers, whereas keywords have to be lower-cased. -See also `ada-auto-case' to disable auto casing altogether." - nil) - -(defun ada-capitalize-word (&optional _arg) - "Upcase first letter and letters following `_', lower case other letters. -ARG is ignored, and is there for compatibility with `capitalize-word' only." - (interactive) - (let ((end (save-excursion (skip-syntax-forward "w") (point))) - (begin (save-excursion (skip-syntax-backward "w") (point)))) - (capitalize-region begin end))) - -(defun ada-adjust-case-region (from to) - "Adjust the case of all words in the region between FROM and TO. -Attention: This function might take very long for big regions!" - (interactive "*r") - (let ((begin nil) - (end nil) - (keywordp nil) - (attribp nil)) - (message "Adjusting case ...") - (with-syntax-table ada-mode-symbol-syntax-table - (save-excursion - (goto-char to) - ;; - ;; loop: look for all identifiers, keywords, and attributes - ;; - (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) - (setq end (match-end 1)) - (setq attribp - (and (> (point) from) - (save-excursion - (forward-char -1) - (setq attribp (looking-at "'.[^']"))))) - (or - ;; do nothing if it is a string or comment - (ada-in-string-or-comment-p) - (progn - ;; - ;; get the identifier or keyword or attribute - ;; - (setq begin (point)) - (setq keywordp (looking-at ada-keywords)) - (goto-char end) - ;; - ;; casing according to user-option - ;; - (if attribp - (funcall ada-case-attribute -1) - (if keywordp - (funcall ada-case-keyword -1) - (ada-adjust-case-identifier))) - (goto-char begin)))) - (message "Adjusting case ... Done"))))) - -(defun ada-adjust-case-buffer () - "Adjust the case of all words in the whole buffer. -ATTENTION: This function might take very long for big buffers!" - (interactive "*") - (ada-adjust-case-region (point-min) (point-max))) - - -;;-------------------------------------------------------------- -;; Format Parameter Lists -;; Some special algorithms are provided to indent the parameter lists in -;; subprogram declarations. This is done in two steps: -;; - First parses the parameter list. The returned list has the following -;; format: -;; ( ( in? out? access? ) -;; ... ) -;; This is done in `ada-scan-paramlist'. -;; - Delete and recreate the parameter list in function -;; `ada-insert-paramlist'. -;; Both steps are called from `ada-format-paramlist'. -;; Note: Comments inside the parameter list are lost. -;; The syntax has to be correct, or the reformatting will fail. -;;-------------------------------------------------------------- - -(defun ada-format-paramlist () - "Reformat the parameter list point is in." - (interactive) - (let ((begin nil) - (end nil) - (delend nil) - (paramlist nil)) - (with-syntax-table ada-mode-symbol-syntax-table - - ;; check if really inside parameter list - (or (ada-in-paramlist-p) - (error "Not in parameter list")) - - ;; find start of current parameter-list - (ada-search-ignore-string-comment - (concat ada-subprog-start-re "\\|\\" ) t nil) - (down-list 1) - (backward-char 1) - (setq begin (point)) - - ;; find end of parameter-list - (forward-sexp 1) - (setq delend (point)) - (delete-char -1) - (insert "\n") - - ;; find end of last parameter-declaration - (forward-comment -1000) - (setq end (point)) - - ;; build a list of all elements of the parameter-list - (setq paramlist (ada-scan-paramlist (1+ begin) end)) - - ;; delete the original parameter-list - (delete-region begin delend) - - ;; insert the new parameter-list - (goto-char begin) - (ada-insert-paramlist paramlist)))) - -(defun ada-scan-paramlist (begin end) - "Scan the parameter list found in between BEGIN and END. -Return the equivalent internal parameter list." - (let ((paramlist (list)) - (param (list)) - (notend t) - (apos nil) - (epos nil) - (semipos nil) - (match-cons nil)) - - (goto-char begin) - - ;; loop until end of last parameter - (while notend - - ;; find first character of parameter-declaration - (ada-goto-next-non-ws) - (setq apos (point)) - - ;; find last character of parameter-declaration - (if (setq match-cons - (ada-search-ignore-string-comment "[ \t\n]*;" nil end t)) - (progn - (setq epos (car match-cons)) - (setq semipos (cdr match-cons))) - (setq epos end)) - - ;; read name(s) of parameter(s) - (goto-char apos) - (looking-at "\\(\\(\\sw\\|[_, \t\n]\\)*\\(\\sw\\|_\\)\\)[ \t\n]*:[^=]") - - (setq param (list (match-string 1))) - (ada-search-ignore-string-comment ":" nil epos t 'search-forward) - - ;; look for 'in' - (setq apos (point)) - (setq param - (append param - (list - (consp - (ada-search-ignore-string-comment - "in" nil epos t 'word-search-forward))))) - - ;; look for 'out' - (goto-char apos) - (setq param - (append param - (list - (consp - (ada-search-ignore-string-comment - "out" nil epos t 'word-search-forward))))) - - ;; look for 'access' - (goto-char apos) - (setq param - (append param - (list - (consp - (ada-search-ignore-string-comment - "access" nil epos t 'word-search-forward))))) - - ;; skip 'in'/'out'/'access' - (goto-char apos) - (ada-goto-next-non-ws) - (while (looking-at "\\<\\(in\\|out\\|access\\)\\>") - (forward-word-strictly 1) - (ada-goto-next-non-ws)) - - ;; read type of parameter - ;; We accept spaces in the name, since some software like Rose - ;; generates something like: "A : B 'Class" - (looking-at "\\<\\(\\sw\\|[_.' \t]\\)+\\>") - (setq param - (append param - (list (match-string 0)))) - - ;; read default-expression, if there is one - (goto-char (setq apos (match-end 0))) - (setq param - (append param - (list - (if (setq match-cons - (ada-search-ignore-string-comment - ":=" nil epos t 'search-forward)) - (buffer-substring (car match-cons) epos) - nil)))) - - ;; add this parameter-declaration to the list - (setq paramlist (append paramlist (list param))) - - ;; check if it was the last parameter - (if (eq epos end) - (setq notend nil) - (goto-char semipos)) - ) - (reverse paramlist))) - -(defun ada-insert-paramlist (paramlist) - "Insert a formatted PARAMLIST in the buffer." - (let ((i (length paramlist)) - (parlen 0) - (typlen 0) - (inp nil) - (outp nil) - (accessp nil) - (column nil) - (firstcol nil)) - - ;; loop until last parameter - (while (not (zerop i)) - (setq i (1- i)) - - ;; get max length of parameter-name - (setq parlen (max parlen (length (nth 0 (nth i paramlist))))) - - ;; get max length of type-name - (setq typlen (max typlen (length (nth 4 (nth i paramlist))))) - - ;; is there any 'in' ? - (setq inp (or inp (nth 1 (nth i paramlist)))) - - ;; is there any 'out' ? - (setq outp (or outp (nth 2 (nth i paramlist)))) - - ;; is there any 'access' ? - (setq accessp (or accessp (nth 3 (nth i paramlist)))) - ) - - ;; does paramlist already start on a separate line ? - (if (save-excursion - (re-search-backward "^.\\|[^ \t]" nil t) - (looking-at "^.")) - ;; yes => re-indent it - (progn - (ada-indent-current) - (save-excursion - (if (looking-at "\\(is\\|return\\)") - (replace-match " \\1")))) - - ;; no => insert it where we are after removing any whitespace - (fixup-whitespace) - (save-excursion - (cond - ((looking-at "[ \t]*\\(\n\\|;\\)") - (replace-match "\\1")) - ((looking-at "[ \t]*\\(is\\|return\\)") - (replace-match " \\1")))) - (insert " ")) - - (insert "(") - (ada-indent-current) - - (setq firstcol (current-column)) - (setq i (length paramlist)) - - ;; loop until last parameter - (while (not (zerop i)) - (setq i (1- i)) - (setq column firstcol) - - ;; insert parameter-name, space and colon - (insert (nth 0 (nth i paramlist))) - (indent-to (+ column parlen 1)) - (insert ": ") - (setq column (current-column)) - - ;; insert 'in' or space - (if (nth 1 (nth i paramlist)) - (insert "in ") - (if (and - (or inp - accessp) - (not (nth 3 (nth i paramlist)))) - (insert " "))) - - ;; insert 'out' or space - (if (nth 2 (nth i paramlist)) - (insert "out ") - (if (and - (or outp - accessp) - (not (nth 3 (nth i paramlist)))) - (insert " "))) - - ;; insert 'access' - (if (nth 3 (nth i paramlist)) - (insert "access ")) - - (setq column (current-column)) - - ;; insert type-name and, if necessary, space and default-expression - (insert (nth 4 (nth i paramlist))) - (if (nth 5 (nth i paramlist)) - (progn - (indent-to (+ column typlen 1)) - (insert (nth 5 (nth i paramlist))))) - - ;; check if it was the last parameter - (if (zerop i) - (insert ")") - ;; no => insert ';' and newline and indent - (insert ";") - (newline) - (indent-to firstcol)) - ) - - ;; if anything follows, except semicolon, newline, is or return - ;; put it in a new line and indent it - (unless (looking-at "[ \t]*\\(;\\|\n\\|is\\|return\\)") - (ada-indent-newline-indent)) - )) - - - -;;;---------------------------------------------------------------- -;; Indentation Engine -;; All indentations are indicated as a two-element string: -;; - position of reference in the buffer -;; - offset to indent from this position (can also be a symbol or a list -;; that are evaluated) -;; Thus the total indentation for a line is the column number of the reference -;; position plus whatever value the evaluation of the second element provides. -;; This mechanism is used so that the Ada mode can "explain" how the -;; indentation was calculated, by showing which variables were used. -;; -;; The indentation itself is done in only one pass: first we try to guess in -;; what context we are by looking at the following keyword or punctuation -;; sign. If nothing remarkable is found, just try to guess the indentation -;; based on previous lines. -;; -;; The relevant functions for indentation are: -;; - `ada-indent-region': Re-indent a region of text -;; - `ada-justified-indent-current': Re-indent the current line and shows the -;; calculation that were done -;; - `ada-indent-current': Re-indent the current line -;; - `ada-get-current-indent': Calculate the indentation for the current line, -;; based on the context (see above). -;; - `ada-get-indent-*': Calculate the indentation in a specific context. -;; For efficiency, these functions do not check they are in the correct -;; context. -;;;---------------------------------------------------------------- - -(defun ada-indent-region (beg end) - "Indent the region between BEG end END." - (interactive "*r") - (goto-char beg) - (let ((block-done 0) - (lines-remaining (count-lines beg end)) - (msg (format "%%4d out of %4d lines remaining ..." - (count-lines beg end))) - (endmark (copy-marker end))) - ;; catch errors while indenting - (while (< (point) endmark) - (if (> block-done 39) - (progn - (setq lines-remaining (- lines-remaining block-done) - block-done 0) - (message msg lines-remaining))) - (if (= (char-after) ?\n) nil - (ada-indent-current)) - (forward-line 1) - (setq block-done (1+ block-done))) - (message "Indenting ... done"))) - -(defun ada-indent-newline-indent () - "Indent the current line, insert a newline and then indent the new line." - (interactive "*") - (ada-indent-current) - (newline) - (ada-indent-current)) - -(defun ada-indent-newline-indent-conditional () - "Insert a newline and indent it. -The original line is re-indented if `ada-indent-after-return' is non-nil." - (interactive "*") - ;; If at end of buffer (entering brand new code), some indentation - ;; fails. For example, a block label requires whitespace following - ;; the : to be recognized. So we do the newline first, then - ;; go back and indent the original line. - (newline) - (if ada-indent-after-return - (progn - (forward-char -1) - (ada-indent-current) - (forward-char 1))) - (ada-indent-current)) - -(defun ada-justified-indent-current () - "Indent the current line and explain how the calculation was done." - (interactive) - - (let ((cur-indent (ada-indent-current))) - - (let ((line (save-excursion - (goto-char (car cur-indent)) - (count-lines 1 (point))))) - - (if (equal (cdr cur-indent) '(0)) - (message (concat "same indentation as line " (number-to-string line))) - (message "%s" (mapconcat (lambda(x) - (cond - ((symbolp x) - (symbol-name x)) - ((numberp x) - (number-to-string x)) - ((listp x) - (concat "- " (symbol-name (cadr x)))) - )) - (cdr cur-indent) - " + ")))) - (save-excursion - (goto-char (car cur-indent)) - (sit-for 1)))) - -(defun ada-batch-reformat () - "Re-indent and re-case all the files found on the command line. -This function should be used from the command line, with a -command like: - emacs -batch -l ada-mode -f ada-batch-reformat file1 file2 ..." - - (while command-line-args-left - (let ((source (car command-line-args-left))) - (message "Formatting %s" source) - (find-file source) - (ada-indent-region (point-min) (point-max)) - (ada-adjust-case-buffer) - (write-file source)) - (setq command-line-args-left (cdr command-line-args-left))) - (message "Done") - (kill-emacs 0)) - -(defsubst ada-goto-previous-word () - "Move point to the beginning of the previous word of Ada code. -Return the new position of point or nil if not found." - (ada-goto-next-word t)) - -(defun ada-indent-current () - "Indent current line as Ada code. -Return the calculation that was done, including the reference point -and the offset." - (interactive) - (let ((orgpoint (point-marker)) - cur-indent tmp-indent - prev-indent) - - (unwind-protect - (with-syntax-table ada-mode-symbol-syntax-table - - ;; This needs to be done here so that the advice is not always - ;; activated (this might interact badly with other modes) - (if (featurep 'xemacs) - (ad-activate 'parse-partial-sexp t)) - - (save-excursion - (setq cur-indent - - ;; Not First line in the buffer ? - (if (save-excursion (zerop (forward-line -1))) - (progn - (back-to-indentation) - (ada-get-current-indent)) - - ;; first line in the buffer - (list (point-min) 0)))) - - ;; Evaluate the list to get the column to indent to - ;; prev-indent contains the column to indent to - (if cur-indent - (setq prev-indent (save-excursion (goto-char (car cur-indent)) - (current-column)) - tmp-indent (cdr cur-indent)) - (setq prev-indent 0 tmp-indent '())) - - (while (not (null tmp-indent)) - (cond - ((numberp (car tmp-indent)) - (setq prev-indent (+ prev-indent (car tmp-indent)))) - (t - (setq prev-indent (+ prev-indent (eval (car tmp-indent))))) - ) - (setq tmp-indent (cdr tmp-indent))) - - ;; only re-indent if indentation is different then the current - (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent) - nil - (beginning-of-line) - (delete-horizontal-space) - (indent-to prev-indent)) - ;; - ;; restore position of point - ;; - (goto-char orgpoint) - (if (< (current-column) (current-indentation)) - (back-to-indentation))) - - (if (featurep 'xemacs) - (ad-deactivate 'parse-partial-sexp))) - - cur-indent)) - -(defun ada-get-current-indent () - "Return the indentation to use for the current line." - (let (column - pos - match-cons - result - (orgpoint (save-excursion - (beginning-of-line) - (forward-comment -10000) - (forward-line 1) - (point)))) - - (setq result - (cond - - ;;----------------------------- - ;; in open parenthesis, but not in parameter-list - ;;----------------------------- - - ((and ada-indent-to-open-paren - (not (ada-in-paramlist-p)) - (setq column (ada-in-open-paren-p))) - - ;; check if we have something like this (Table_Component_Type => - ;; Source_File_Record) - (save-excursion - - ;; Align the closing parenthesis on the opening one - (if (= (following-char) ?\)) - (save-excursion - (goto-char column) - (skip-chars-backward " \t") - (list (1- (point)) 0)) - - (if (and (skip-chars-backward " \t") - (= (char-before) ?\n) - (not (forward-comment -10000)) - (= (char-before) ?>)) - ;; ??? Could use a different variable - (list column 'ada-broken-indent) - - ;; We want all continuation lines to be indented the same - ;; (ada-broken-line from the opening parenthesis. However, in - ;; parameter list, each new parameter should be indented at the - ;; column as the opening parenthesis. - - ;; A special case to handle nested boolean expressions, as in - ;; ((B - ;; and then C) -- indented by ada-broken-indent - ;; or else D) -- indenting this line. - ;; ??? This is really a hack, we should have a proper way to go to - ;; ??? the beginning of the statement - - (if (= (char-before) ?\)) - (backward-sexp)) - - (if (memq (char-before) '(?, ?\; ?\( ?\))) - (list column 0) - (list column 'ada-continuation-indent) - ))))) - - ;;--------------------------- - ;; at end of buffer - ;;--------------------------- - - ((not (char-after)) - (ada-indent-on-previous-lines nil orgpoint orgpoint)) - - ;;--------------------------- - ;; starting with e - ;;--------------------------- - - ((= (downcase (char-after)) ?e) - (cond - - ;; ------- end ------ - - ((looking-at "end\\>") - (let ((label 0) - limit) - (save-excursion - (ada-goto-matching-start 1) - - ;; - ;; found 'loop' => skip back to 'while' or 'for' - ;; if 'loop' is not on a separate line - ;; Stop the search for 'while' and 'for' when a ';' is encountered. - ;; - (if (save-excursion - (beginning-of-line) - (looking-at ".+\\")) - (progn - (save-excursion - (setq limit (car (ada-search-ignore-string-comment ";" t)))) - (if (save-excursion - (and - (setq match-cons - (ada-search-ignore-string-comment ada-loop-start-re t limit)) - (not (looking-at "\\")))) - (progn - (goto-char (car match-cons)) - (save-excursion - (back-to-indentation) - (if (looking-at ada-block-label-re) - (setq label (- ada-label-indent)))))))) - - ;; found 'record' => - ;; if the keyword is found at the beginning of a line (or just - ;; after limited, we indent on it, otherwise we indent on the - ;; beginning of the type declaration) - ;; type A is (B : Integer; - ;; C : Integer) is record - ;; end record; -- This is badly indented otherwise - (if (looking-at "record") - (if (save-excursion - (beginning-of-line) - (looking-at "^[ \t]*\\(record\\|limited record\\)")) - (list (save-excursion (back-to-indentation) (point)) 0) - (list (save-excursion - (car (ada-search-ignore-string-comment "\\" t))) - 0)) - - ;; Else keep the same indentation as the beginning statement - (list (+ (save-excursion (back-to-indentation) (point)) label) 0))))) - - ;; ------ exception ---- - - ((looking-at "exception\\>") - (save-excursion - (ada-goto-matching-start 1) - (list (save-excursion (back-to-indentation) (point)) 0))) - - ;; else - - ((looking-at "else\\>") - (if (save-excursion (ada-goto-previous-word) - (looking-at "\\")) - (ada-indent-on-previous-lines nil orgpoint orgpoint) - (save-excursion - (ada-goto-matching-start 1 nil t) - (list (progn (back-to-indentation) (point)) 0)))) - - ;; elsif - - ((looking-at "elsif\\>") - (save-excursion - (ada-goto-matching-start 1 nil t) - (list (progn (back-to-indentation) (point)) 0))) - - )) - - ;;--------------------------- - ;; starting with w (when) - ;;--------------------------- - - ((and (= (downcase (char-after)) ?w) - (looking-at "when\\>")) - (save-excursion - (ada-goto-matching-start 1) - (list (save-excursion (back-to-indentation) (point)) - 'ada-when-indent))) - - ;;--------------------------- - ;; starting with t (then) - ;;--------------------------- - - ((and (= (downcase (char-after)) ?t) - (looking-at "then\\>")) - (if (save-excursion (ada-goto-previous-word) - (looking-at "and\\>")) - (ada-indent-on-previous-lines nil orgpoint orgpoint) - (save-excursion - ;; Select has been added for the statement: "select ... then abort" - (ada-search-ignore-string-comment - "\\<\\(elsif\\|if\\|select\\)\\>" t nil) - (list (progn (back-to-indentation) (point)) - 'ada-stmt-end-indent)))) - - ;;--------------------------- - ;; starting with l (loop) - ;;--------------------------- - - ((and (= (downcase (char-after)) ?l) - (looking-at "loop\\>")) - (setq pos (point)) - (save-excursion - (goto-char (match-end 0)) - (ada-goto-stmt-start) - (if (looking-at "\\<\\(loop\\|if\\)\\>") - (ada-indent-on-previous-lines nil orgpoint orgpoint) - (unless (looking-at ada-loop-start-re) - (ada-search-ignore-string-comment ada-loop-start-re - nil pos)) - (if (looking-at "\\") - (ada-indent-on-previous-lines nil orgpoint orgpoint) - (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent))))) - - ;;---------------------------- - ;; starting with l (limited) or r (record) - ;;---------------------------- - - ((or (and (= (downcase (char-after)) ?l) - (looking-at "limited\\>")) - (and (= (downcase (char-after)) ?r) - (looking-at "record\\>"))) - - (save-excursion - (ada-search-ignore-string-comment - "\\<\\(type\\|use\\)\\>" t nil) - (if (looking-at "\\") - (ada-search-ignore-string-comment "for" t nil nil - 'word-search-backward)) - (list (progn (back-to-indentation) (point)) - 'ada-indent-record-rel-type))) - - ;;--------------------------- - ;; starting with b (begin) - ;;--------------------------- - - ((and (= (downcase (char-after)) ?b) - (looking-at "begin\\>")) - (save-excursion - (if (ada-goto-decl-start t) - (list (progn (back-to-indentation) (point)) 0) - (ada-indent-on-previous-lines nil orgpoint orgpoint)))) - - ;;--------------------------- - ;; starting with i (is) - ;;--------------------------- - - ((and (= (downcase (char-after)) ?i) - (looking-at "is\\>")) - - (if (and ada-indent-is-separate - (save-excursion - (goto-char (match-end 0)) - (ada-goto-next-non-ws (point-at-eol)) - (looking-at "\\\\|\\"))) - (save-excursion - (ada-goto-stmt-start) - (list (progn (back-to-indentation) (point)) 'ada-indent)) - (save-excursion - (ada-goto-stmt-start) - (if (looking-at "\\") - (list (progn (back-to-indentation) (point)) 0) - (list (progn (back-to-indentation) (point)) 'ada-indent))))) - - ;;--------------------------- - ;; starting with r (return, renames) - ;;--------------------------- - - ((and (= (downcase (char-after)) ?r) - (looking-at "re\\(turn\\|names\\)\\>")) - - (save-excursion - (let ((var 'ada-indent-return)) - ;; If looking at a renames, skip the 'return' statement too - (if (looking-at "renames") - (let (pos) - (save-excursion - (setq pos (ada-search-ignore-string-comment ";\\|return\\>" t))) - (if (and pos - (= (downcase (char-after (car pos))) ?r)) - (goto-char (car pos))) - (setq var 'ada-indent-renames))) - - (forward-comment -1000) - (if (= (char-before) ?\)) - (forward-sexp -1) - (forward-word-strictly -1)) - - ;; If there is a parameter list, and we have a function declaration - ;; or access to subprogram declaration - (let ((num-back 1)) - (if (and (= (following-char) ?\() - (save-excursion - (or (progn - (backward-word-strictly 1) - (looking-at "\\(function\\|procedure\\)\\>")) - (progn - (backward-word-strictly 1) - (setq num-back 2) - (looking-at "\\(function\\|procedure\\)\\>"))))) - - ;; The indentation depends of the value of ada-indent-return - (if (<= (eval var) 0) - (list (point) (list '- var)) - (list (progn (backward-word-strictly num-back) (point)) - var)) - - ;; Else there is no parameter list, but we have a function - ;; Only do something special if the user want to indent - ;; relative to the "function" keyword - (if (and (> (eval var) 0) - (save-excursion (forward-word-strictly -1) - (looking-at "function\\>"))) - (list (progn (forward-word-strictly -1) (point)) var) - - ;; Else... - (ada-indent-on-previous-lines nil orgpoint orgpoint))))))) - - ;;-------------------------------- - ;; starting with 'o' or 'p' - ;; 'or' as statement-start - ;; 'private' as statement-start - ;;-------------------------------- - - ((and (or (= (downcase (char-after)) ?o) - (= (downcase (char-after)) ?p)) - (or (ada-looking-at-semi-or) - (ada-looking-at-semi-private))) - (save-excursion - ;; ??? Wasn't this done already in ada-looking-at-semi-or ? - (ada-goto-matching-start 1) - (list (progn (back-to-indentation) (point)) 0))) - - ;;-------------------------------- - ;; starting with 'd' (do) - ;;-------------------------------- - - ((and (= (downcase (char-after)) ?d) - (looking-at "do\\>")) - (save-excursion - (ada-goto-stmt-start) - (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent))) - - ;;-------------------------------- - ;; starting with '-' (comment) - ;;-------------------------------- - - ((= (char-after) ?-) - (if ada-indent-comment-as-code - - ;; Indent comments on previous line comments if required - ;; We must use a search-forward (even if the code is more complex), - ;; since we want to find the beginning of the comment. - (let (pos) - - (if (and ada-indent-align-comments - (save-excursion - (forward-line -1) - (beginning-of-line) - (while (and (not pos) - (search-forward "--" (point-at-eol) t)) - (unless (ada-in-string-p) - (setq pos (point)))) - pos)) - (list (- pos 2) 0) - - ;; Else always on previous line - (ada-indent-on-previous-lines nil orgpoint orgpoint))) - - ;; Else same indentation as the previous line - (list (save-excursion (back-to-indentation) (point)) 0))) - - ;;-------------------------------- - ;; starting with '#' (preprocessor line) - ;;-------------------------------- - - ((and (= (char-after) ?#) - (equal ada-which-compiler 'gnat) - (looking-at "#[ \t]*\\(if\\|els\\(e\\|if\\)\\|end[ \t]*if\\)")) - (list (point-at-bol) 0)) - - ;;-------------------------------- - ;; starting with ')' (end of a parameter list) - ;;-------------------------------- - - ((and (not (eobp)) (= (char-after) ?\))) - (save-excursion - (forward-char 1) - (backward-sexp 1) - (list (point) 0))) - - ;;--------------------------------- - ;; new/abstract/separate - ;;--------------------------------- - - ((looking-at "\\(new\\|abstract\\|separate\\)\\>") - (ada-indent-on-previous-lines nil orgpoint orgpoint)) - - ;;--------------------------------- - ;; package/function/procedure - ;;--------------------------------- - - ((and (or (= (downcase (char-after)) ?p) (= (downcase (char-after)) ?f)) - (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")) - (save-excursion - ;; Go up until we find either a generic section, or the end of the - ;; previous subprogram/package, or 'overriding' for this function/procedure - (let (found) - (while (and (not found) - (ada-search-ignore-string-comment - "\\<\\(generic\\|end\\|begin\\|overriding\\|package\\|procedure\\|function\\)\\>" t)) - - ;; avoid "with procedure"... in generic parts - (save-excursion - (forward-word-strictly -1) - (setq found (not (looking-at "with")))))) - - (cond - ((looking-at "\\") - (list (progn (back-to-indentation) (point)) 0)) - - (t - (ada-indent-on-previous-lines nil orgpoint orgpoint))))) - - ;;--------------------------------- - ;; label - ;;--------------------------------- - - ((looking-at ada-label-re) - (if (ada-in-decl-p) - ;; ada-block-label-re matches variable declarations - (ada-indent-on-previous-lines nil orgpoint orgpoint) - (append (ada-indent-on-previous-lines nil orgpoint orgpoint) - '(ada-label-indent)))) - - )) - - ;;--------------------------------- - ;; Other syntaxes - ;;--------------------------------- - (or result (ada-indent-on-previous-lines nil orgpoint orgpoint)))) - -(defun ada-indent-on-previous-lines (&optional nomove orgpoint initial-pos) - "Calculate the indentation for the new line after ORGPOINT. -The result list is based on the previous lines in the buffer. -If NOMOVE is nil, moves point to the beginning of the current statement. -if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation." - (if initial-pos - (goto-char initial-pos)) - (let ((oldpoint (point))) - - ;; Is inside a parameter-list ? - (if (ada-in-paramlist-p) - (ada-get-indent-paramlist) - - ;; Move to beginning of current statement. If already at a - ;; statement start, move to beginning of enclosing statement. - (unless nomove - (ada-goto-stmt-start t)) - - ;; no beginning found => don't change indentation - (if (and (eq oldpoint (point)) - (not nomove)) - (ada-get-indent-nochange) - - (cond - ;; - ((and - ada-indent-to-open-paren - (ada-in-open-paren-p)) - (ada-get-indent-open-paren)) - ;; - ((looking-at "end\\>") - (ada-get-indent-end orgpoint)) - ;; - ((looking-at ada-loop-start-re) - (ada-get-indent-loop orgpoint)) - ;; - ((looking-at ada-subprog-start-re) - (ada-get-indent-subprog orgpoint)) - ;; - ((looking-at ada-block-start-re) - (ada-get-indent-block-start orgpoint)) - ;; - ((looking-at ada-block-label-re) ; also variable declaration - (ada-get-indent-block-label orgpoint)) - ;; - ((looking-at ada-goto-label-re) - (ada-get-indent-goto-label orgpoint)) - ;; - ((looking-at "\\(sub\\)?type\\>") - (ada-get-indent-type orgpoint)) - ;; - ;; "then" has to be included in the case of "select...then abort" - ;; statements, since (goto-stmt-start) at the beginning of - ;; the current function would leave the cursor on that position - ((looking-at "\\(\\(els\\)?if\\>\\)\\|then abort\\>") - (ada-get-indent-if orgpoint)) - ;; - ((looking-at "case\\>") - (ada-get-indent-case orgpoint)) - ;; - ((looking-at "when\\>") - (ada-get-indent-when orgpoint)) - ;; - ((looking-at "separate\\>") - (ada-get-indent-nochange)) - ;; - ((looking-at "with\\>\\|use\\>") - ;; Are we still in that statement, or are we in fact looking at - ;; the previous one ? - (if (save-excursion (search-forward ";" oldpoint t)) - (list (progn (back-to-indentation) (point)) 0) - (list (point) (if (looking-at "with") - 'ada-with-indent - 'ada-use-indent)))) - ;; - (t - (ada-get-indent-noindent orgpoint))))) - )) - -(defun ada-get-indent-open-paren () - "Calculate the indentation when point is behind an unclosed parenthesis." - (list (ada-in-open-paren-p) 0)) - -(defun ada-get-indent-nochange () - "Return the current indentation of the previous line." - (save-excursion - (forward-line -1) - (back-to-indentation) - (list (point) 0))) - -(defun ada-get-indent-paramlist () - "Calculate the indentation when point is inside a parameter list." - (save-excursion - (ada-search-ignore-string-comment "[^ \t\n]" t nil t) - (cond - ;; in front of the first parameter - ((= (char-after) ?\() - (goto-char (match-end 0)) - (list (point) 0)) - - ;; in front of another parameter - ((= (char-after) ?\;) - (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) - (ada-goto-next-non-ws) - (list (point) 0)) - - ;; After an affectation (default parameter value in subprogram - ;; declaration) - ((and (= (following-char) ?=) (= (preceding-char) ?:)) - (back-to-indentation) - (list (point) 'ada-broken-indent)) - - ;; inside a parameter declaration - (t - (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) - (ada-goto-next-non-ws) - (list (point) 'ada-broken-indent))))) - -(defun ada-get-indent-end (orgpoint) - "Calculate the indentation when point is just before an end statement. -ORGPOINT is the limit position used in the calculation." - (let ((defun-name nil) - (indent nil)) - - ;; is the line already terminated by ';' ? - (if (save-excursion - (ada-search-ignore-string-comment ";" nil orgpoint nil - 'search-forward)) - - ;; yes, look what's following 'end' - (progn - (forward-word-strictly 1) - (ada-goto-next-non-ws) - (cond - ;; - ;; loop/select/if/case/return - ;; - ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|return\\)\\>") - (save-excursion (ada-check-matching-start (match-string 0))) - (list (save-excursion (back-to-indentation) (point)) 0)) - - ;; - ;; record - ;; - ((looking-at "\\") - (save-excursion - (ada-check-matching-start (match-string 0)) - ;; we are now looking at the matching "record" statement - (forward-word-strictly 1) - (ada-goto-stmt-start) - ;; now on the matching type declaration, or use clause - (unless (looking-at "\\(for\\|type\\)\\>") - (ada-search-ignore-string-comment "\\" t)) - (list (progn (back-to-indentation) (point)) 0))) - ;; - ;; a named block end - ;; - ((looking-at ada-ident-re) - (setq defun-name (match-string 0)) - (save-excursion - (ada-goto-matching-start 0) - (ada-check-defun-name defun-name)) - (list (progn (back-to-indentation) (point)) 0)) - ;; - ;; a block-end without name - ;; - ((= (char-after) ?\;) - (save-excursion - (ada-goto-matching-start 0) - (if (looking-at "\\") - (progn - (setq indent (list (point) 0)) - (if (ada-goto-decl-start t) - (list (progn (back-to-indentation) (point)) 0) - indent)) - (list (progn (back-to-indentation) (point)) 0) - ))) - ;; - ;; anything else - should maybe signal an error ? - ;; - (t - (list (save-excursion (back-to-indentation) (point)) - 'ada-broken-indent)))) - - (list (save-excursion (back-to-indentation) (point)) - 'ada-broken-indent)))) - -(defun ada-get-indent-case (orgpoint) - "Calculate the indentation when point is just before a case statement. -ORGPOINT is the limit position used in the calculation." - (let ((match-cons nil) - (opos (point))) - (cond - ;; - ;; case..is..when..=> - ;; - ((save-excursion - (setq match-cons (and - ;; the `=>' must be after the keyword `is'. - (ada-search-ignore-string-comment - "is" nil orgpoint nil 'word-search-forward) - (ada-search-ignore-string-comment - "[ \t\n]+=>" nil orgpoint)))) - (save-excursion - (goto-char (car match-cons)) - (unless (ada-search-ignore-string-comment "when" t opos) - (error "Missing `when' between `case' and `=>'")) - (list (save-excursion (back-to-indentation) (point)) 'ada-indent))) - ;; - ;; case..is..when - ;; - ((save-excursion - (setq match-cons (ada-search-ignore-string-comment - "when" nil orgpoint nil 'word-search-forward))) - (goto-char (cdr match-cons)) - (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)) - ;; - ;; case..is - ;; - ((save-excursion - (setq match-cons (ada-search-ignore-string-comment - "is" nil orgpoint nil 'word-search-forward))) - (list (save-excursion (back-to-indentation) (point)) 'ada-when-indent)) - ;; - ;; incomplete case - ;; - (t - (list (save-excursion (back-to-indentation) (point)) - 'ada-broken-indent))))) - -(defun ada-get-indent-when (orgpoint) - "Calculate the indentation when point is just before a when statement. -ORGPOINT is the limit position used in the calculation." - (let ((cur-indent (save-excursion (back-to-indentation) (point)))) - (if (ada-search-ignore-string-comment "[ \t\n]*=>" nil orgpoint) - (list cur-indent 'ada-indent) - (list cur-indent 'ada-broken-indent)))) - -(defun ada-get-indent-if (orgpoint) - "Calculate the indentation when point is just before an if statement. -ORGPOINT is the limit position used in the calculation." - (let ((cur-indent (save-excursion (back-to-indentation) (point))) - (match-cons nil)) - ;; - ;; Move to the correct then (ignore all "and then") - ;; - (while (and (setq match-cons (ada-search-ignore-string-comment - "\\<\\(then\\|and[ \t]*then\\)\\>" - nil orgpoint)) - (= (downcase (char-after (car match-cons))) ?a))) - ;; If "then" was found (we are looking at it) - (if match-cons - (progn - ;; - ;; 'then' first in separate line ? - ;; => indent according to 'then', - ;; => else indent according to 'if' - ;; - (if (save-excursion - (back-to-indentation) - (looking-at "\\")) - (setq cur-indent (save-excursion (back-to-indentation) (point)))) - ;; skip 'then' - (forward-word-strictly 1) - (list cur-indent 'ada-indent)) - - (list cur-indent 'ada-broken-indent)))) - -(defun ada-get-indent-block-start (orgpoint) - "Calculate the indentation when point is at the start of a block. -ORGPOINT is the limit position used in the calculation." - (let ((pos nil)) - (cond - ((save-excursion - (forward-word-strictly 1) - (setq pos (ada-goto-next-non-ws orgpoint))) - (goto-char pos) - (save-excursion - (ada-indent-on-previous-lines t orgpoint))) - - ;; Special case for record types, for instance for: - ;; type A is (B : Integer; - ;; C : Integer) is record - ;; null; -- This is badly indented otherwise - ((looking-at "record") - - ;; If record is at the beginning of the line, indent from there - (if (save-excursion - (beginning-of-line) - (looking-at "^[ \t]*\\(record\\|limited record\\)")) - (list (save-excursion (back-to-indentation) (point)) 'ada-indent) - - ;; else indent relative to the type command - (list (save-excursion - (car (ada-search-ignore-string-comment "\\" t))) - 'ada-indent))) - - ;; Special case for label: - ((looking-at ada-block-label-re) - (list (- (save-excursion (back-to-indentation) (point)) ada-label-indent) 'ada-indent)) - - ;; nothing follows the block-start - (t - (list (save-excursion (back-to-indentation) (point)) 'ada-indent))))) - -(defun ada-get-indent-subprog (orgpoint) - "Calculate the indentation when point is just before a subprogram. -ORGPOINT is the limit position used in the calculation." - (let ((match-cons nil) - (cur-indent (save-excursion (back-to-indentation) (point))) - (foundis nil)) - ;; - ;; is there an 'is' in front of point ? - ;; - (if (save-excursion - (setq match-cons - (ada-search-ignore-string-comment - "\\<\\(is\\|do\\)\\>" nil orgpoint))) - ;; - ;; yes, then skip to its end - ;; - (progn - (setq foundis t) - (goto-char (cdr match-cons))) - ;; - ;; no, then goto next non-ws, if there is one in front of point - ;; - (progn - (unless (ada-goto-next-non-ws orgpoint) - (goto-char orgpoint)))) - - (cond - ;; - ;; nothing follows 'is' - ;; - ((and - foundis - (save-excursion - (not (ada-search-ignore-string-comment - "[^ \t\n]" nil orgpoint t)))) - (list cur-indent 'ada-indent)) - ;; - ;; is abstract/separate/new ... - ;; - ((and - foundis - (save-excursion - (setq match-cons - (ada-search-ignore-string-comment - "\\<\\(separate\\|new\\|abstract\\)\\>" - nil orgpoint)))) - (goto-char (car match-cons)) - (ada-search-ignore-string-comment ada-subprog-start-re t) - (ada-get-indent-noindent orgpoint)) - ;; - ;; something follows 'is' - ;; - ((and - foundis - (save-excursion (setq match-cons (ada-goto-next-non-ws orgpoint))) - (goto-char match-cons) - (ada-indent-on-previous-lines t orgpoint))) - ;; - ;; no 'is' but ';' - ;; - ((save-excursion - (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward)) - (list cur-indent 0)) - ;; - ;; no 'is' or ';' - ;; - (t - (list cur-indent 'ada-broken-indent))))) - -(defun ada-get-indent-noindent (orgpoint) - "Calculate the indentation when point is just before a `noindent stmt'. -ORGPOINT is the limit position used in the calculation." - (let ((label 0)) - (save-excursion - (beginning-of-line) - - (cond - - ;; This one is called when indenting a line preceded by a multi-line - ;; subprogram declaration (in that case, we are at this point inside - ;; the parameter declaration list) - ((ada-in-paramlist-p) - (ada-previous-procedure) - (list (save-excursion (back-to-indentation) (point)) 0)) - - ;; This one is called when indenting the second line of a multi-line - ;; declaration section, in a declare block or a record declaration - ((looking-at "[ \t]*\\(\\sw\\|_\\)*[ \t]*,[ \t]*$") - (list (save-excursion (back-to-indentation) (point)) - 'ada-broken-decl-indent)) - - ;; This one is called in every other case when indenting a line at the - ;; top level - (t - (if (looking-at (concat "[ \t]*" ada-block-label-re)) - (setq label (- ada-label-indent)) - - (let (p) - - ;; "with private" or "null record" cases - (if (or (save-excursion - (and (ada-search-ignore-string-comment "\\" nil orgpoint) - (setq p (point)) - (save-excursion (forward-char -7);; skip back "private" - (ada-goto-previous-word) - (looking-at "with")))) - (save-excursion - (and (ada-search-ignore-string-comment "\\" nil orgpoint) - (setq p (point)) - (save-excursion (forward-char -6);; skip back "record" - (ada-goto-previous-word) - (looking-at "null"))))) - (progn - (goto-char p) - (re-search-backward "\\<\\(type\\|subtype\\)\\>" nil t) - (list (save-excursion (back-to-indentation) (point)) 0))))) - (if (save-excursion - (ada-search-ignore-string-comment ";" nil orgpoint nil - 'search-forward)) - (list (+ (save-excursion (back-to-indentation) (point)) label) 0) - (list (+ (save-excursion (back-to-indentation) (point)) label) - 'ada-broken-indent))))))) - -(defun ada-get-indent-block-label (orgpoint) - "Calculate the indentation when before a label or variable declaration. -ORGPOINT is the limit position used in the calculation." - (let ((match-cons nil) - (cur-indent (save-excursion (back-to-indentation) (point)))) - (ada-search-ignore-string-comment ":" nil) - (cond - ;; loop label - ((save-excursion - (setq match-cons (ada-search-ignore-string-comment - ada-loop-start-re nil orgpoint))) - (goto-char (car match-cons)) - (ada-get-indent-loop orgpoint)) - - ;; declare label - ((save-excursion - (setq match-cons (ada-search-ignore-string-comment - "\\" nil orgpoint))) - (goto-char (car match-cons)) - (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) - - ;; variable declaration - ((ada-in-decl-p) - (if (save-excursion - (ada-search-ignore-string-comment ";" nil orgpoint)) - (list cur-indent 0) - (list cur-indent 'ada-broken-indent))) - - ;; nothing follows colon - (t - (list cur-indent '(- ada-label-indent)))))) - -(defun ada-get-indent-goto-label (orgpoint) - "Calculate the indentation when at a goto label." - (search-forward ">>") - (ada-goto-next-non-ws) - (if (>= (point) orgpoint) - ;; labeled statement is the one we need to indent - (list (- (point) ada-label-indent)) - ;; else indentation is indent for labeled statement - (ada-indent-on-previous-lines t orgpoint))) - -(defun ada-get-indent-loop (orgpoint) - "Calculate the indentation when just before a loop or a for ... use. -ORGPOINT is the limit position used in the calculation." - (let ((match-cons nil) - (pos (point)) - - ;; If looking at a named block, skip the label - (label (save-excursion - (back-to-indentation) - (if (looking-at ada-block-label-re) - (- ada-label-indent) - 0)))) - - (cond - - ;; - ;; statement complete - ;; - ((save-excursion - (ada-search-ignore-string-comment ";" nil orgpoint nil - 'search-forward)) - (list (+ (save-excursion (back-to-indentation) (point)) label) 0)) - ;; - ;; simple loop - ;; - ((looking-at "loop\\>") - (setq pos (ada-get-indent-block-start orgpoint)) - (if (equal label 0) - pos - (list (+ (car pos) label) (cadr pos)))) - - ;; - ;; 'for'- loop (or also a for ... use statement) - ;; - ((looking-at "for\\>") - (cond - ;; - ;; for ... use - ;; - ((save-excursion - (and - (goto-char (match-end 0)) - (ada-goto-next-non-ws orgpoint) - (forward-word-strictly 1) - (if (= (char-after) ?') (forward-word-strictly 1) t) - (ada-goto-next-non-ws orgpoint) - (looking-at "\\") - ;; - ;; check if there is a 'record' before point - ;; - (progn - (setq match-cons (ada-search-ignore-string-comment - "record" nil orgpoint nil 'word-search-forward)) - t))) - (if match-cons - (progn - (goto-char (car match-cons)) - (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) - (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)) - ) - - ;; - ;; for..loop - ;; - ((save-excursion - (setq match-cons (ada-search-ignore-string-comment - "loop" nil orgpoint nil 'word-search-forward))) - (goto-char (car match-cons)) - ;; - ;; indent according to 'loop', if it's first in the line; - ;; otherwise to 'for' - ;; - (unless (save-excursion - (back-to-indentation) - (looking-at "\\")) - (goto-char pos)) - (list (+ (save-excursion (back-to-indentation) (point)) label) - 'ada-indent)) - ;; - ;; for-statement is broken - ;; - (t - (list (+ (save-excursion (back-to-indentation) (point)) label) - 'ada-broken-indent)))) - - ;; - ;; 'while'-loop - ;; - ((looking-at "while\\>") - ;; - ;; while..loop ? - ;; - (if (save-excursion - (setq match-cons (ada-search-ignore-string-comment - "loop" nil orgpoint nil 'word-search-forward))) - - (progn - (goto-char (car match-cons)) - ;; - ;; indent according to 'loop', if it's first in the line; - ;; otherwise to 'while'. - ;; - (unless (save-excursion - (back-to-indentation) - (looking-at "\\")) - (goto-char pos)) - (list (+ (save-excursion (back-to-indentation) (point)) label) - 'ada-indent)) - - (list (+ (save-excursion (back-to-indentation) (point)) label) - 'ada-broken-indent)))))) - -(defun ada-get-indent-type (orgpoint) - "Calculate the indentation when before a type statement. -ORGPOINT is the limit position used in the calculation." - (let ((match-dat nil)) - (cond - ;; - ;; complete record declaration - ;; - ((save-excursion - (and - (setq match-dat (ada-search-ignore-string-comment - "end" nil orgpoint nil 'word-search-forward)) - (ada-goto-next-non-ws) - (looking-at "\\") - (forward-word-strictly 1) - (ada-goto-next-non-ws) - (= (char-after) ?\;))) - (goto-char (car match-dat)) - (list (save-excursion (back-to-indentation) (point)) 0)) - ;; - ;; record type - ;; - ((save-excursion - (setq match-dat (ada-search-ignore-string-comment - "record" nil orgpoint nil 'word-search-forward))) - (goto-char (car match-dat)) - (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) - ;; - ;; complete type declaration - ;; - ((save-excursion - (ada-search-ignore-string-comment ";" nil orgpoint nil - 'search-forward)) - (list (save-excursion (back-to-indentation) (point)) 0)) - ;; - ;; "type ... is", but not "type ... is ...", which is broken - ;; - ((save-excursion - (and - (ada-search-ignore-string-comment "is" nil orgpoint nil - 'word-search-forward) - (not (ada-goto-next-non-ws orgpoint)))) - (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)) - ;; - ;; broken statement - ;; - (t - (list (save-excursion (back-to-indentation) (point)) - 'ada-broken-indent))))) - - -;; ----------------------------------------------------------- -;; -- searching and matching -;; ----------------------------------------------------------- - -(defun ada-goto-stmt-start (&optional ignore-goto-label) - "Move point to the beginning of the statement that point is in or after. -Return the new position of point. -As a special case, if we are looking at a closing parenthesis, skip to the -open parenthesis." - (let ((match-dat nil) - (orgpoint (point))) - - (setq match-dat (ada-search-prev-end-stmt)) - (if match-dat - - ;; - ;; found a previous end-statement => check if anything follows - ;; - (unless (looking-at "declare") - (progn - (unless (save-excursion - (goto-char (cdr match-dat)) - (ada-goto-next-non-ws orgpoint ignore-goto-label)) - ;; - ;; nothing follows => it's the end-statement directly in - ;; front of point => search again - ;; - (setq match-dat (ada-search-prev-end-stmt))) - ;; - ;; if found the correct end-statement => goto next non-ws - ;; - (if match-dat - (goto-char (cdr match-dat))) - (ada-goto-next-non-ws) - )) - - ;; - ;; no previous end-statement => we are at the beginning of the - ;; accessible part of the buffer - ;; - (progn - (goto-char (point-min)) - ;; - ;; skip to the very first statement, if there is one - ;; - (unless (ada-goto-next-non-ws orgpoint) - (goto-char orgpoint)))) - (point))) - - -(defun ada-search-prev-end-stmt () - "Move point to previous end statement. -Return a cons cell whose car is the beginning and whose cdr -is the end of the match." - (let ((match-dat nil) - (found nil)) - - ;; search until found or beginning-of-buffer - (while - (and - (not found) - (setq match-dat (ada-search-ignore-string-comment - ada-end-stmt-re t))) - - (goto-char (car match-dat)) - (unless (ada-in-open-paren-p) - (cond - - ((and (looking-at - "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>") - (save-excursion - (ada-goto-previous-word) - (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]"))) - (forward-word-strictly -1)) - - ((looking-at "is") - (setq found - (and (save-excursion (ada-goto-previous-word) - (ada-goto-previous-word) - (not (looking-at "subtype"))) - - (save-excursion (goto-char (cdr match-dat)) - (ada-goto-next-non-ws) - ;; words that can go after an 'is' - (not (looking-at - (eval-when-compile - (concat "\\<" - (regexp-opt - '("separate" "access" "array" - "private" "abstract" "new") t) - "\\>\\|(")))))))) - - ((looking-at "private") - (save-excursion - (backward-word-strictly 1) - (setq found (not (looking-at "is"))))) - - (t - (setq found t)) - ))) - - (if found - match-dat - nil))) - -(defun ada-goto-next-non-ws (&optional limit skip-goto-label) - "Skip to next non-whitespace character. -Skips spaces, newlines and comments, and possibly goto labels. -Return `point' if moved, nil if not. -Stop the search at LIMIT. -Do not call this function from within a string." - (unless limit - (setq limit (point-max))) - (while (and (<= (point) limit) - (or (progn (forward-comment 10000) - (if (and (not (eobp)) - (save-excursion (forward-char 1) - (ada-in-string-p))) - (progn (forward-sexp 1) t))) - (and skip-goto-label - (looking-at ada-goto-label-re) - (progn - (goto-char (match-end 0)) - t))))) - (if (< (point) limit) - (point) - nil) - ) - - -(defun ada-goto-stmt-end (&optional limit) - "Move point to the end of the statement that point is in or before. -Return the new position of point or nil if not found. -Stop the search at LIMIT." - (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit) - (point) - nil)) - - -(defun ada-goto-next-word (&optional backward) - "Move point to the beginning of the next word of Ada code. -If BACKWARD is non-nil, jump to the beginning of the previous word. -Return the new position of point or nil if not found." - (let ((match-cons nil) - (orgpoint (point))) - (unless backward - (skip-syntax-forward "w_")) - (if (setq match-cons - (ada-search-ignore-string-comment "\\sw\\|\\s_" backward nil t)) - ;; - ;; move to the beginning of the word found - ;; - (progn - (goto-char (car match-cons)) - (skip-syntax-backward "w_") - (point)) - ;; - ;; if not found, restore old position of point - ;; - (goto-char orgpoint) - 'nil))) - - -(defun ada-check-matching-start (keyword) - "Signal an error if matching block start is not KEYWORD. -Moves point to the matching block start." - (ada-goto-matching-start 0) - (unless (looking-at (concat "\\<" keyword "\\>")) - (error "Matching start is not `%s'" keyword))) - - -(defun ada-check-defun-name (defun-name) - "Check if the name of the matching defun really is DEFUN-NAME. -Assumes point to be already positioned by `ada-goto-matching-start'. -Moves point to the beginning of the declaration." - - ;; named block without a `declare'; ada-goto-matching-start leaves - ;; point at start of 'begin' for a block. - (if (save-excursion - (ada-goto-previous-word) - (looking-at (concat "\\<" defun-name "\\> *:"))) - t ; name matches - ;; else - ;; - ;; 'accept' or 'package' ? - ;; - (unless (looking-at ada-subprog-start-re) - (ada-goto-decl-start)) - ;; - ;; 'begin' of 'procedure'/'function'/'task' or 'declare' - ;; - (save-excursion - ;; - ;; a named 'declare'-block ? => jump to the label - ;; - (if (looking-at "\\") - (progn - (forward-comment -1) - (backward-word-strictly 1)) - ;; - ;; no, => 'procedure'/'function'/'task'/'protected' - ;; - (progn - (forward-word-strictly 2) - (backward-word-strictly 1) - ;; - ;; skip 'body' 'type' - ;; - (if (looking-at "\\<\\(body\\|type\\)\\>") - (forward-word-strictly 1)) - (forward-sexp 1) - (backward-sexp 1))) - ;; - ;; should be looking-at the correct name - ;; - (unless (looking-at (concat "\\<" defun-name "\\>")) - (error "Matching defun has different name: %s" - (buffer-substring (point) - (progn (forward-sexp 1) (point)))))))) - -(defun ada-goto-decl-start (&optional noerror) - "Move point to the declaration start of the current construct. -If NOERROR is non-nil, return nil if no match was found; -otherwise throw error." - (let ((nest-count 1) - (regexp (eval-when-compile - (concat "\\<" - (regexp-opt - '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t) - "\\>"))) - - ;; first should be set to t if we should stop at the first - ;; "begin" we encounter. - (first t) - (count-generic nil) - (stop-at-when nil) - ) - - ;; Ignore "when" most of the time, except if we are looking at the - ;; beginning of a block (structure: case .. is - ;; when ... => - ;; begin ... - ;; exception ... ) - (if (looking-at "begin") - (setq stop-at-when t)) - - (if (or - (looking-at "\\<\\(package\\|procedure\\|function\\)\\>") - (save-excursion - (ada-search-ignore-string-comment - "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t) - (looking-at "generic"))) - (setq count-generic t)) - - ;; search backward for interesting keywords - (while (and - (not (zerop nest-count)) - (ada-search-ignore-string-comment regexp t)) - ;; - ;; calculate nest-depth - ;; - (cond - ;; - ((looking-at "end") - (ada-goto-matching-start 1 noerror) - - ;; In some case, two begin..end block can follow each other closely, - ;; which we have to detect, as in - ;; procedure P is - ;; procedure Q is - ;; begin - ;; end; - ;; begin -- here we should go to procedure, not begin - ;; end - - (if (looking-at "begin") - (let ((loop-again t)) - (save-excursion - (while loop-again - ;; If begin was just there as the beginning of a block - ;; (with no declare) then do nothing, otherwise just - ;; register that we have to find the statement that - ;; required the begin - - (ada-search-ignore-string-comment - "\\<\\(declare\\|begin\\|end\\|procedure\\|function\\|task\\|package\\)\\>" - t) - - (if (looking-at "end") - (ada-goto-matching-start 1 noerror t) - - (setq loop-again nil) - (unless (looking-at "begin") - (setq nest-count (1+ nest-count)))) - )) - ))) - ;; - ((looking-at "generic") - (if count-generic - (progn - (setq first nil) - (setq nest-count (1- nest-count))))) - ;; - ((looking-at "if") - (save-excursion - (forward-word-strictly -1) - (unless (looking-at "\\") - (progn - (setq nest-count (1- nest-count)) - (setq first nil))))) - - ;; - ((looking-at "declare\\|generic") - (setq nest-count (1- nest-count)) - (setq first t)) - ;; - ((looking-at "is") - ;; look for things to ignore - (if - (or - ;; generic formal parameter - (looking-at "is[ t]+<>") - - ;; A type definition, or a case statement. Note that the - ;; goto-matching-start above on 'end record' leaves us at - ;; 'record', not at 'type'. - ;; - ;; We get to a case statement here by calling - ;; 'ada-move-to-end' from inside a case statement; then - ;; we are not ignoring 'when'. - (save-excursion - ;; Skip type discriminants or case argument function call param list - (forward-comment -10000) - (forward-char -1) - (if (= (char-after) ?\)) - (progn - (forward-char 1) - (backward-sexp 1) - (forward-comment -10000) - )) - ;; skip type or case argument name - (skip-chars-backward "a-zA-Z0-9_.'") - (ada-goto-previous-word) - (and - ;; if it's a protected type, it's the decl start we - ;; are looking for; since we didn't see the 'end' - ;; above, we are inside it. - (looking-at "\\<\\(sub\\)?type\\|case\\>") - (save-match-data - (ada-goto-previous-word) - (not (looking-at "\\")))) - ) ; end of type definition p - - ;; null procedure declaration - (save-excursion (ada-goto-next-word) (looking-at "\\")) - );; end or - ;; skip this construct - nil - ;; this is the right "is" - (setq nest-count (1- nest-count)) - (setq first nil))) - - ;; - ((looking-at "new") - (if (save-excursion - (ada-goto-previous-word) - (looking-at "is")) - (goto-char (match-beginning 0)))) - ;; - ((and first - (looking-at "begin")) - (setq nest-count 0)) - ;; - ((looking-at "when") - (save-excursion - (forward-word-strictly -1) - (unless (looking-at "\\") - (progn - (if stop-at-when - (setq nest-count (1- nest-count))) - )))) - ;; - ((looking-at "begin") - (setq first nil)) - ;; - (t - (setq nest-count (1+ nest-count)) - (setq first nil))) - - );; end of loop - - ;; check if declaration-start is really found - (if (and - (zerop nest-count) - (if (looking-at "is") - (ada-search-ignore-string-comment ada-subprog-start-re t) - (looking-at "declare\\|generic"))) - t - (if noerror nil - (error "No matching proc/func/task/declare/package/protected"))) - )) - -(defun ada-goto-matching-start (&optional nest-level noerror gotothen) - "Move point to the beginning of a block-start. -Which block depends on the value of NEST-LEVEL, which defaults to zero. -If NOERROR is non-nil, it only returns nil if no matching start was found. -If GOTOTHEN is non-nil, point moves to the `then' following `if'." - (let ((nest-count (if nest-level nest-level 0)) - (found nil) - - (last-was-begin '()) - ;; List all keywords encountered while traversing - ;; something like '("end" "end" "begin") - ;; This is removed from the list when "package", "procedure",... - ;; are seen. The goal is to find whether a package has an elaboration - ;; part - - (pos nil)) - - ;; search backward for interesting keywords - (while (and - (not found) - (ada-search-ignore-string-comment ada-matching-start-re t)) - - (unless (and (looking-at "\\") - (save-excursion - (forward-word-strictly -1) - (looking-at "\\"))) - (progn - ;; calculate nest-depth - (cond - ;; found block end => increase nest depth - ((looking-at "end") - (push nil last-was-begin) - (setq nest-count (1+ nest-count))) - - ;; found loop/select/record/case/if => check if it starts or - ;; ends a block - ((looking-at "loop\\|select\\|record\\|case\\|if") - (setq pos (point)) - (save-excursion - ;; check if keyword follows 'end' - (ada-goto-previous-word) - (if (looking-at "\\[ \t]*[^;]") - (progn - ;; it ends a block => increase nest depth - (setq nest-count (1+ nest-count) - pos (point)) - (push nil last-was-begin)) - - ;; it starts a block => decrease nest depth - (setq nest-count (1- nest-count)) - - ;; Some nested "begin .. end" blocks with no "declare"? - ;; => remove those entries - (while (car last-was-begin) - (setq last-was-begin (cdr (cdr last-was-begin)))) - - (setq last-was-begin (cdr last-was-begin)) - )) - (goto-char pos) - ) - - ;; found package start => check if it really is a block - ((looking-at "package") - (save-excursion - ;; ignore if this is just a renames statement - (let ((current (point)) - (pos (ada-search-ignore-string-comment - "\\<\\(is\\|renames\\|;\\)\\>" nil))) - (if pos - (goto-char (car pos)) - (error (concat - "No matching `is' or `renames' for `package' at" - " line " - (number-to-string (count-lines 1 (1+ current))))))) - (unless (looking-at "renames") - (progn - (forward-word-strictly 1) - (ada-goto-next-non-ws) - ;; ignore it if it is only a declaration with 'new' - ;; We could have package Foo is new .... - ;; or package Foo is separate; - ;; or package Foo is begin null; end Foo - ;; for elaboration code (elaboration) - (if (and (not (looking-at "\\<\\(new\\|separate\\|begin\\)\\>")) - (not (car last-was-begin))) - (setq nest-count (1- nest-count)))))) - - (setq last-was-begin (cdr last-was-begin)) - ) - ;; found task start => check if it has a body - ((looking-at "task") - (save-excursion - (forward-word-strictly 1) - (ada-goto-next-non-ws) - (cond - ((looking-at "\\")) - ((looking-at "\\") - ;; In that case, do nothing if there is a "is" - (forward-word-strictly 2);; skip "type" - (ada-goto-next-non-ws);; skip type name - - ;; Do nothing if we are simply looking at a simple - ;; "task type name;" statement with no block - (unless (looking-at ";") - (progn - ;; Skip the parameters - (if (looking-at "(") - (ada-search-ignore-string-comment ")" nil)) - (let ((tmp (ada-search-ignore-string-comment - "\\<\\(is\\|;\\)\\>" nil))) - (if tmp - (progn - (goto-char (car tmp)) - (if (looking-at "is") - (setq nest-count (1- nest-count))))))))) - (t - ;; Check if that task declaration had a block attached to - ;; it (i.e do nothing if we have just "task name;") - (unless (progn (forward-word-strictly 1) - (looking-at "[ \t]*;")) - (setq nest-count (1- nest-count)))))) - (setq last-was-begin (cdr last-was-begin)) - ) - - ((looking-at "declare") - ;; remove entry for begin and end (include nested begin..end - ;; groups) - (setq last-was-begin (cdr last-was-begin)) - (let ((count 1)) - (while (and (> count 0)) - (if (equal (car last-was-begin) t) - (setq count (1+ count)) - (setq count (1- count))) - (setq last-was-begin (cdr last-was-begin)) - ))) - - ((looking-at "protected") - ;; Ignore if this is just a declaration - (save-excursion - (let ((pos (ada-search-ignore-string-comment - "\\(\\\\|\\\\|;\\)" nil))) - (if pos - (goto-char (car pos))) - (if (looking-at "is") - ;; remove entry for end - (setq last-was-begin (cdr last-was-begin))))) - (setq nest-count (1- nest-count))) - - ((or (looking-at "procedure") - (looking-at "function")) - ;; Ignore if this is just a declaration - (save-excursion - (let ((pos (ada-search-ignore-string-comment - "\\(\\\\|\\\\|)[ \t]*;\\)" nil))) - (if pos - (goto-char (car pos))) - (if (looking-at "is") - ;; remove entry for begin and end - (setq last-was-begin (cdr (cdr last-was-begin)))))) - ) - - ;; all the other block starts - (t - (push (looking-at "begin") last-was-begin) - (setq nest-count (1- nest-count))) - - ) - - ;; match is found, if nest-depth is zero - (setq found (zerop nest-count))))) ; end of loop - - (if (bobp) - (point) - (if found - ;; - ;; match found => is there anything else to do ? - ;; - (progn - (cond - ;; - ;; found 'if' => skip to 'then', if it's on a separate line - ;; and GOTOTHEN is non-nil - ;; - ((and - gotothen - (looking-at "if") - (save-excursion - (ada-search-ignore-string-comment "then" nil nil nil - 'word-search-forward) - (back-to-indentation) - (looking-at "\\"))) - (goto-char (match-beginning 0))) - - ;; - ;; found 'do' => skip back to 'accept' or 'return' - ;; - ((looking-at "do") - (unless (ada-search-ignore-string-comment - "\\" t) - (error "Missing `accept' or `return' in front of `do'")))) - (point)) - - (if noerror - nil - (error "No matching start")))))) - - -(defun ada-goto-matching-end (&optional nest-level noerror) - "Move point to the end of a block. -Which block depends on the value of NEST-LEVEL, which defaults to zero. -If NOERROR is non-nil, it only returns nil if no matching start found." - (let ((nest-count (or nest-level 0)) - (regex (eval-when-compile - (concat "\\<" - (regexp-opt '("end" "loop" "select" "begin" "case" - "if" "task" "package" "record" "do" - "procedure" "function") t) - "\\>"))) - found - pos - - ;; First is used for subprograms: they are generally handled - ;; recursively, but of course we do not want to do that the - ;; first time (see comment below about subprograms) - (first (not (looking-at "declare")))) - - ;; If we are already looking at one of the keywords, this shouldn't count - ;; in the nesting loop below, so we just make sure we don't count it. - ;; "declare" is a special case because we need to look after the "begin" - ;; keyword - (if (looking-at "\\") - (forward-char 1)) - - ;; - ;; search forward for interesting keywords - ;; - (while (and - (not found) - (ada-search-ignore-string-comment regex nil)) - - ;; - ;; calculate nest-depth - ;; - (backward-word-strictly 1) - (cond - ;; procedures and functions need to be processed recursively, in - ;; case they are defined in a declare/begin block, as in: - ;; declare -- NL 0 (nested level) - ;; A : Boolean; - ;; procedure B (C : D) is - ;; begin -- NL 1 - ;; null; - ;; end B; -- NL 0, and we would exit - ;; begin - ;; end; -- we should exit here - ;; processing them recursively avoids the need for any special - ;; handling. - ;; Nothing should be done if we have only the specs or a - ;; generic instantiation. - - ((and (looking-at "\\")) - (if first - (forward-word-strictly 1) - - (setq pos (point)) - (ada-search-ignore-string-comment "is\\|;") - (if (= (char-before) ?s) - (progn - (ada-goto-next-non-ws) - (unless (looking-at "\\") - (progn - (goto-char pos) - (ada-goto-matching-end 0 t))))))) - - ;; found block end => decrease nest depth - ((looking-at "\\") - (setq nest-count (1- nest-count) - found (<= nest-count 0)) - ;; skip the following keyword - (if (progn - (skip-chars-forward "end") - (ada-goto-next-non-ws) - (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>")) - (forward-word-strictly 1))) - - ;; found package start => check if it really starts a block, and is not - ;; in fact a generic instantiation for instance - ((looking-at "\\") - (ada-search-ignore-string-comment "is" nil nil nil - 'word-search-forward) - (ada-goto-next-non-ws) - ;; ignore and skip it if it is only a 'new' package - (if (looking-at "\\") - (goto-char (match-end 0)) - (setq nest-count (1+ nest-count) - found (<= nest-count 0)))) - - ;; all the other block starts - (t - (if (not first) - (setq nest-count (1+ nest-count))) - (setq found (<= nest-count 0)) - (forward-word-strictly 1))) ; end of 'cond' - - (setq first nil)) - - (if found - t - (if noerror - nil - (error "No matching end"))) - )) - - -(defun ada-search-ignore-string-comment - (search-re &optional backward limit paramlists search-func) - "Regexp-search for SEARCH-RE, ignoring comments, strings. -Returns a cons cell of begin and end of match data or nil, if not found. -If BACKWARD is non-nil, search backward; search forward otherwise. -The search stops at pos LIMIT. -If PARAMLISTS is nil, ignore parameter lists. -The search is done using SEARCH-FUNC. SEARCH-FUNC can be optimized -in case we are searching for a constant string. -Point is moved at the beginning of the SEARCH-RE." - (let (found - begin - end - parse-result) - - ;; FIXME: need to pass BACKWARD to search-func! - (unless search-func - (setq search-func (if backward 're-search-backward 're-search-forward))) - - ;; - ;; search until found or end-of-buffer - ;; We have to test that we do not look further than limit - ;; - (with-syntax-table ada-mode-symbol-syntax-table - (while (and (not found) - (or (not limit) - (or (and backward (<= limit (point))) - (>= limit (point)))) - (funcall search-func search-re limit 1)) - (setq begin (match-beginning 0)) - (setq end (match-end 0)) - (setq parse-result (parse-partial-sexp (point-at-bol) (point))) - (cond - ;; - ;; If inside a string, skip it (and the following comments) - ;; - ((ada-in-string-p parse-result) - (if (featurep 'xemacs) - (search-backward "\"" nil t) - (goto-char (nth 8 parse-result))) - (unless backward (forward-sexp 1))) - ;; - ;; If inside a comment, skip it (and the following comments) - ;; There is a special code for comments at the end of the file - ;; - ((ada-in-comment-p parse-result) - (if (featurep 'xemacs) - (progn - (forward-line 1) - (beginning-of-line) - (forward-comment -1)) - (goto-char (nth 8 parse-result))) - (unless backward - ;; at the end of the file, it is not possible to skip a comment - ;; so we just go at the end of the line - (if (forward-comment 1) - (progn - (forward-comment 1000) - (beginning-of-line)) - (end-of-line)))) - ;; - ;; directly in front of a comment => skip it, if searching forward - ;; - ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-)) - (unless backward (progn (forward-char -1) (forward-comment 1000)))) - - ;; - ;; found a parameter-list but should ignore it => skip it - ;; - ((and (not paramlists) (ada-in-paramlist-p)) - (if backward - (search-backward "(" nil t) - (search-forward ")" nil t))) - ;; - ;; found what we were looking for - ;; - (t - (setq found t))))) ; end of loop - - (if found - (cons begin end) - nil))) - -;; ------------------------------------------------------- -;; -- Testing the position of the cursor -;; ------------------------------------------------------- - -(defun ada-in-decl-p () - "Return t if point is inside a declarative part. -Assumes point to be at the end of a statement." - (or (ada-in-paramlist-p) - (save-excursion - (ada-goto-decl-start t)))) - - -(defun ada-looking-at-semi-or () - "Return t if looking at an `or' following a semicolon." - (save-excursion - (and (looking-at "\\") - (progn - (forward-word-strictly 1) - (ada-goto-stmt-start) - (looking-at "\\"))))) - - -(defun ada-looking-at-semi-private () - "Return t if looking at the start of a private section in a package. -Return nil if the private is part of the package name, as in -'private package A is...' (this can only happen at top level)." - (save-excursion - (and (looking-at "\\") - (not (looking-at "\\")))))))) - - -(defun ada-in-paramlist-p () - "Return t if point is inside the parameter-list of a declaration, but not a subprogram call or aggregate." - (save-excursion - (and - (ada-search-ignore-string-comment "(\\|)" t nil t) - ;; inside parentheses ? - (= (char-after) ?\() - - ;; We could be looking at two things here: - ;; operator definition: function "." ( - ;; subprogram definition: procedure .... ( - ;; Let's skip back over the first one - (progn - (skip-chars-backward " \t\n") - (if (= (char-before) ?\") - (backward-char 3) - (backward-word-strictly 1)) - t) - - ;; and now over the second one - (backward-word-strictly 1) - - ;; We should ignore the case when the reserved keyword is in a - ;; comment (for instance, when we have: - ;; -- .... package - ;; Test (A) - ;; we should return nil - - (not (ada-in-string-or-comment-p)) - - ;; right keyword two words before parenthesis ? - ;; Type is in this list because of discriminants - ;; pragma is not, because the syntax is that of a subprogram call. - (looking-at (eval-when-compile - (concat "\\<\\(" - "procedure\\|function\\|body\\|" - "task\\|entry\\|accept\\|" - "access[ \t]+procedure\\|" - "access[ \t]+function\\|" - "type\\)\\>")))))) - -(defun ada-search-ignore-complex-boolean (regexp backwardp) - "Search for REGEXP, ignoring comments, strings, `and then', `or else'. -If BACKWARDP is non-nil, search backward; search forward otherwise." - (let (result) - (while (and (setq result (ada-search-ignore-string-comment regexp backwardp)) - (save-excursion (forward-word-strictly -1) - (looking-at "and then\\|or else")))) - result)) - -(defun ada-in-open-paren-p () - "Non-nil if in an open parenthesis. -Return value is the position of the first non-ws behind the last unclosed -parenthesis, or nil." - (save-excursion - (let ((parse (parse-partial-sexp - ;; In Emacs 28, TO has to be greater than FROM. - (or (car (ada-search-ignore-complex-boolean - "\\<\\(;\\|is\\|then\\|loop\\|begin\\|else\\)\\>" - t)) - (point-min)) - (point)))) - - (if (nth 1 parse) - (progn - (goto-char (1+ (nth 1 parse))) - - ;; Skip blanks, if they are not followed by a comment - ;; See: - ;; type A is ( Value_0, - ;; Value_1); - ;; type B is ( -- comment - ;; Value_2); - - (if (or (not ada-indent-handle-comment-special) - (not (looking-at "[ \t]+--"))) - (skip-chars-forward " \t")) - - (point)))))) - - -;; ----------------------------------------------------------- -;; -- Behavior Of TAB Key -;; ----------------------------------------------------------- - -(defun ada-tab () - "Do indenting or tabbing according to `ada-tab-policy'. -In Transient Mark mode, if the mark is active, operate on the contents -of the region. Otherwise, operate only on the current line." - (interactive) - (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard)) - ((eq ada-tab-policy 'indent-auto) - (if (ada-region-selected) - (ada-indent-region (region-beginning) (region-end)) - (ada-indent-current))) - ((eq ada-tab-policy 'always-tab) (error "Not implemented")) - )) - -(defun ada-untab (_arg) - "Delete leading indenting according to `ada-tab-policy'." - ;; FIXME: ARG is ignored - (interactive "P") - (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard)) - ((eq ada-tab-policy 'indent-auto) (error "Not implemented")) - ((eq ada-tab-policy 'always-tab) (error "Not implemented")) - )) - -(defun ada-indent-current-function () - "Ada mode version of the `indent-line-function'." - (interactive "*") - (let ((starting-point (point-marker))) - (beginning-of-line) - (ada-tab) - (if (< (point) starting-point) - (goto-char starting-point)) - (set-marker starting-point nil) - )) - -(defun ada-tab-hard () - "Indent current line to next tab stop." - (interactive) - (save-excursion - (beginning-of-line) - (insert-char ? ada-indent)) - (if (bolp) (forward-char ada-indent))) - -(defun ada-untab-hard () - "Indent current line to previous tab stop." - (interactive) - (indent-rigidly (point-at-bol) (point-at-eol) (- 0 ada-indent))) - - -;; ------------------------------------------------------------ -;; -- Miscellaneous -;; ------------------------------------------------------------ - -;; Not needed any more for Emacs 21.2, but still needed for backward -;; compatibility -(defun ada-remove-trailing-spaces () - "Remove trailing spaces in the whole buffer." - (interactive) - (save-match-data - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward "[ \t]+$" (point-max) t) - (replace-match "" nil nil)))))) - -(defun ada-gnat-style () - "Clean up comments, `(' and `,' for GNAT style checking switch." - (interactive) - (save-excursion - - ;; The \n is required, or the line after an empty comment line is - ;; simply ignored. - (goto-char (point-min)) - (while (re-search-forward "--[ \t]*\\([^-\n]\\)" nil t) - (replace-match "-- \\1") - (forward-line 1) - (beginning-of-line)) - - (goto-char (point-min)) - (while (re-search-forward "\\>(" nil t) - (if (not (ada-in-string-or-comment-p)) - (replace-match " ("))) - (goto-char (point-min)) - (while (re-search-forward ";--" nil t) - (forward-char -1) - (if (not (ada-in-string-or-comment-p)) - (replace-match "; --"))) - (goto-char (point-min)) - (while (re-search-forward "([ \t]+" nil t) - (if (not (ada-in-string-or-comment-p)) - (replace-match "("))) - (goto-char (point-min)) - (while (re-search-forward ")[ \t]+)" nil t) - (if (not (ada-in-string-or-comment-p)) - (replace-match "))"))) - (goto-char (point-min)) - (while (re-search-forward "\\>:" nil t) - (if (not (ada-in-string-or-comment-p)) - (replace-match " :"))) - - ;; Make sure there is a space after a ','. - ;; Always go back to the beginning of the match, since otherwise - ;; a statement like ('F','D','E') is incorrectly modified. - (goto-char (point-min)) - (while (re-search-forward ",[ \t]*\\(.\\)" nil t) - (if (not (save-excursion - (goto-char (match-beginning 0)) - (ada-in-string-or-comment-p))) - (replace-match ", \\1"))) - - ;; Operators should be surrounded by spaces. - (goto-char (point-min)) - (while (re-search-forward - "[ \t]*\\(/=\\|\\*\\*\\|:=\\|\\.\\.\\|[-:+*/]\\)[ \t]*" - nil t) - (goto-char (match-beginning 1)) - (if (or (looking-at "--") - (ada-in-string-or-comment-p)) - (progn - (forward-line 1) - (beginning-of-line)) - (cond - ((string= (match-string 1) "/=") - (replace-match " /= ")) - ((string= (match-string 1) "..") - (replace-match " .. ")) - ((string= (match-string 1) "**") - (replace-match " ** ")) - ((string= (match-string 1) ":=") - (replace-match " := ")) - (t - (replace-match " \\1 "))) - (forward-char 1))) - )) - - - -;; ------------------------------------------------------------- -;; -- Moving To Procedures/Packages/Statements -;; ------------------------------------------------------------- - -(defun ada-move-to-start () - "Move point to the matching start of the current Ada structure." - (interactive) - (let ((pos (point))) - (with-syntax-table ada-mode-symbol-syntax-table - - (save-excursion - ;; - ;; do nothing if in string or comment or not on 'end ...;' - ;; or if an error occurs during processing - ;; - (or - (ada-in-string-or-comment-p) - (and (progn - (or (looking-at "[ \t]*\\") - (backward-word-strictly 1)) - (or (looking-at "[ \t]*\\") - (backward-word-strictly 1)) - (or (looking-at "[ \t]*\\") - (error "Not on end ...;"))) - (ada-goto-matching-start 1) - (setq pos (point)) - - ;; - ;; on 'begin' => go on, according to user option - ;; - ada-move-to-declaration - (looking-at "\\") - (ada-goto-decl-start) - (setq pos (point)))) - - ) ; end of save-excursion - - ;; now really move to the found position - (goto-char pos)))) - -(defun ada-move-to-end () - "Move point to the end of the block around point. -Moves to `begin' if in a declarative part." - (interactive) - (let ((pos (point)) - decl-start) - (with-syntax-table ada-mode-symbol-syntax-table - - (save-excursion - - (cond - ;; Go to the beginning of the current word, and check if we are - ;; directly on 'begin' - ((save-excursion - (skip-syntax-backward "w") - (looking-at "\\")) - (ada-goto-matching-end 1)) - - ;; on first line of subprogram body - ;; Do nothing for specs or generic instantiation, since these are - ;; handled as the general case (find the enclosing block) - ;; We also need to make sure that we ignore nested subprograms - ((save-excursion - (and (skip-syntax-backward "w") - (looking-at "\\\\|\\" ) - (ada-search-ignore-string-comment "is\\|;") - (not (= (char-before) ?\;)) - )) - (skip-syntax-backward "w") - (ada-goto-matching-end 0 t)) - - ;; on first line of task declaration - ((save-excursion - (and (ada-goto-stmt-start) - (looking-at "\\" ) - (forward-word-strictly 1) - (ada-goto-next-non-ws) - (looking-at "\\"))) - (ada-search-ignore-string-comment "begin" nil nil nil - 'word-search-forward)) - ;; accept block start - ((save-excursion - (and (ada-goto-stmt-start) - (looking-at "\\" ))) - (ada-goto-matching-end 0)) - ;; package start - ((save-excursion - (setq decl-start (and (ada-goto-decl-start t) (point))) - (and decl-start (looking-at "\\"))) - (ada-goto-matching-end 1)) - - ;; On a "declare" keyword - ((save-excursion - (skip-syntax-backward "w") - (looking-at "\\")) - (ada-goto-matching-end 0 t)) - - ;; inside a 'begin' ... 'end' block - (decl-start - (goto-char decl-start) - (ada-goto-matching-end 0 t)) - - ;; (hopefully ;-) everything else - (t - (ada-goto-matching-end 1))) - (setq pos (point)) - ) - - ;; now really move to the position found - (goto-char pos)))) - -(defun ada-next-procedure () - "Move point to next procedure." - (interactive) - (end-of-line) - (if (re-search-forward ada-procedure-start-regexp nil t) - (goto-char (match-beginning 4)) - (error "No more functions/procedures/tasks"))) - -(defun ada-previous-procedure () - "Move point to previous procedure." - (interactive) - (beginning-of-line) - (if (re-search-backward ada-procedure-start-regexp nil t) - (goto-char (match-beginning 4)) - (error "No more functions/procedures/tasks"))) - -(defun ada-next-package () - "Move point to next package." - (interactive) - (end-of-line) - (if (re-search-forward ada-package-start-regexp nil t) - (goto-char (match-beginning 1)) - (error "No more packages"))) - -(defun ada-previous-package () - "Move point to previous package." - (interactive) - (beginning-of-line) - (if (re-search-backward ada-package-start-regexp nil t) - (goto-char (match-beginning 1)) - (error "No more packages"))) - - -;; ------------------------------------------------------------ -;; -- Define keymap and menus for Ada -;; ------------------------------------------------------------- - -(defun ada-create-keymap () - "Create the keymap associated with the Ada mode." - - ;; All non-standard keys go into ada-mode-extra-map - (define-key ada-mode-map ada-mode-extra-prefix ada-mode-extra-map) - - ;; Indentation and Formatting - (define-key ada-mode-map "\C-j" 'ada-indent-newline-indent-conditional) - (define-key ada-mode-map "\C-m" 'ada-indent-newline-indent-conditional) - (define-key ada-mode-map "\t" 'ada-tab) - (define-key ada-mode-map "\C-c\t" 'ada-justified-indent-current) - (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region) - (define-key ada-mode-map [(shift tab)] 'ada-untab) - (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist) - ;; We don't want to make meta-characters case-specific. - - ;; Movement - (define-key ada-mode-map "\M-\C-e" 'ada-next-procedure) - (define-key ada-mode-map "\M-\C-a" 'ada-previous-procedure) - (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start) - (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end) - - ;; Compilation - (unless (lookup-key ada-mode-map "\C-c\C-c") - (define-key ada-mode-map "\C-c\C-c" 'compile)) - - ;; Casing - (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer) - (define-key ada-mode-map "\C-c\C-t" 'ada-case-read-exceptions) - (define-key ada-mode-map "\C-c\C-y" 'ada-create-case-exception) - (define-key ada-mode-map "\C-c\C-\M-y" 'ada-create-case-exception-substring) - - ;; On XEmacs, you can easily specify whether DEL should deletes - ;; one character forward or one character backward. Take this into - ;; account - (define-key ada-mode-map - (if (boundp 'delete-key-deletes-forward) [backspace] "\177") - 'backward-delete-char-untabify) - - ;; Make body - (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body) - - ;; Use predefined function of Emacs19 for comments (RE) - ;; FIXME: Made redundant with Emacs-21's standard comment-dwim binding on M-; - (define-key ada-mode-map "\C-c;" 'comment-region) - (define-key ada-mode-map "\C-c:" 'ada-uncomment-region) - - ;; The following keys are bound to functions defined in ada-xref.el or - ;; ada-prj,el., However, RMS rightly thinks that the code should be shared, - ;; and activated only if the right compiler is used - - (define-key ada-mode-map (if (featurep 'xemacs) '(shift button3) [S-mouse-3]) - 'ada-point-and-xref) - (define-key ada-mode-map [(control tab)] 'ada-complete-identifier) - - (define-key ada-mode-extra-map "o" 'ff-find-other-file) - (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame) - (define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration) - (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference) - (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application) - (define-key ada-mode-extra-map "c" 'ada-change-prj) - (define-key ada-mode-extra-map "d" 'ada-set-default-project-file) - (define-key ada-mode-extra-map "g" 'ada-gdb-application) - (define-key ada-mode-map "\C-c\C-m" 'ada-set-main-compile-application) - (define-key ada-mode-extra-map "r" 'ada-run-application) - (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent) - (define-key ada-mode-map "\C-c\C-r" 'ada-find-references) - (define-key ada-mode-extra-map "l" 'ada-find-local-references) - (define-key ada-mode-map "\C-c\C-v" 'ada-check-current) - (define-key ada-mode-extra-map "f" 'ada-find-file) - - (define-key ada-mode-extra-map "u" 'ada-prj-edit) - - (define-key ada-mode-map "\C-xnd" 'ada-narrow-to-defun); override narrow-to-defun - - ;; The templates, defined in ada-stmt.el - - (let ((map (make-sparse-keymap))) - (define-key map "h" 'ada-header) - (define-key map "\C-a" 'ada-array) - (define-key map "b" 'ada-exception-block) - (define-key map "d" 'ada-declare-block) - (define-key map "c" 'ada-case) - (define-key map "\C-e" 'ada-elsif) - (define-key map "e" 'ada-else) - (define-key map "\C-k" 'ada-package-spec) - (define-key map "k" 'ada-package-body) - (define-key map "\C-p" 'ada-procedure-spec) - (define-key map "p" 'ada-subprogram-body) - (define-key map "\C-f" 'ada-function-spec) - (define-key map "f" 'ada-for-loop) - (define-key map "i" 'ada-if) - (define-key map "l" 'ada-loop) - (define-key map "\C-r" 'ada-record) - (define-key map "\C-s" 'ada-subtype) - (define-key map "S" 'ada-tabsize) - (define-key map "\C-t" 'ada-task-spec) - (define-key map "t" 'ada-task-body) - (define-key map "\C-y" 'ada-type) - (define-key map "\C-v" 'ada-private) - (define-key map "u" 'ada-use) - (define-key map "\C-u" 'ada-with) - (define-key map "\C-w" 'ada-when) - (define-key map "w" 'ada-while-loop) - (define-key map "\C-x" 'ada-exception) - (define-key map "x" 'ada-exit) - (define-key ada-mode-extra-map "t" map)) - ) - - -(defun ada-create-menu () - "Create the Ada menu as shown in the menu bar." - (let ((m '("Ada" - ("Help" - ["Ada Mode" (info "ada-mode") t] - ["GNAT User's Guide" (info "gnat_ugn") - (eq ada-which-compiler 'gnat)] - ["GNAT Reference Manual" (info "gnat_rm") - (eq ada-which-compiler 'gnat)] - ["Gcc Documentation" (info "gcc") - (eq ada-which-compiler 'gnat)] - ["Gdb Documentation" (info "gdb") - (eq ada-which-compiler 'gnat)] - ["Ada95 Reference Manual" (info "arm95") t]) - ("Options" :included (derived-mode-p 'ada-mode) - ["Auto Casing" (setq ada-auto-case (not ada-auto-case)) - :style toggle :selected ada-auto-case] - ["Auto Indent After Return" - (setq ada-indent-after-return (not ada-indent-after-return)) - :style toggle :selected ada-indent-after-return] - ["Automatically Recompile For Cross-references" - (setq ada-xref-create-ali (not ada-xref-create-ali)) - :style toggle :selected ada-xref-create-ali - :included (eq ada-which-compiler 'gnat)] - ["Confirm Commands" - (setq ada-xref-confirm-compile (not ada-xref-confirm-compile)) - :style toggle :selected ada-xref-confirm-compile - :included (eq ada-which-compiler 'gnat)] - ["Show Cross-references In Other Buffer" - (setq ada-xref-other-buffer (not ada-xref-other-buffer)) - :style toggle :selected ada-xref-other-buffer - :included (eq ada-which-compiler 'gnat)] - ["Tight Integration With GNU Visual Debugger" - (setq ada-tight-gvd-integration (not ada-tight-gvd-integration)) - :style toggle :selected ada-tight-gvd-integration - :included (string-match "gvd" ada-prj-default-debugger)]) - ["Customize" (customize-group 'ada) - :included (fboundp 'customize-group)] - ["Check file" ada-check-current t] - ["Compile file" ada-compile-current t] - ["Set main and Build" ada-set-main-compile-application t] - ["Show main" ada-show-current-main t] - ["Build" ada-compile-application t] - ["Run" ada-run-application t] - ["Debug" ada-gdb-application (eq ada-which-compiler 'gnat)] - ["------" nil nil] - ("Project" - ["Show project" ada-show-current-project t] - ["Load..." ada-set-default-project-file t] - ["New..." ada-prj-new t] - ["Edit..." ada-prj-edit t]) - ("Goto" :included (derived-mode-p 'ada-mode) - ["Goto Declaration/Body" ada-goto-declaration - (eq ada-which-compiler 'gnat)] - ["Goto Body" ada-goto-body - (eq ada-which-compiler 'gnat)] - ["Goto Declaration Other Frame" - ada-goto-declaration-other-frame - (eq ada-which-compiler 'gnat)] - ["Goto Previous Reference" ada-xref-goto-previous-reference - (eq ada-which-compiler 'gnat)] - ["List Local References" ada-find-local-references - (eq ada-which-compiler 'gnat)] - ["List References" ada-find-references - (eq ada-which-compiler 'gnat)] - ["Goto Reference To Any Entity" ada-find-any-references - (eq ada-which-compiler 'gnat)] - ["Goto Parent Unit" ada-goto-parent - (eq ada-which-compiler 'gnat)] - ["--" nil nil] - ["Next compilation error" next-error t] - ["Previous Package" ada-previous-package t] - ["Next Package" ada-next-package t] - ["Previous Procedure" ada-previous-procedure t] - ["Next Procedure" ada-next-procedure t] - ["Goto Start Of Statement" ada-move-to-start t] - ["Goto End Of Statement" ada-move-to-end t] - ["-" nil nil] - ["Other File" ff-find-other-file t] - ["Other File Other Window" ada-ff-other-window t]) - ("Edit" :included (derived-mode-p 'ada-mode) - ["Search File On Source Path" ada-find-file t] - ["------" nil nil] - ["Complete Identifier" ada-complete-identifier t] - ["-----" nil nil] - ["Indent Line" ada-indent-current-function t] - ["Justify Current Indentation" ada-justified-indent-current t] - ["Indent Lines in Selection" ada-indent-region t] - ["Indent Lines in File" - (ada-indent-region (point-min) (point-max)) t] - ["Format Parameter List" ada-format-paramlist t] - ["-" nil nil] - ["Comment Selection" comment-region t] - ["Uncomment Selection" ada-uncomment-region t] - ["--" nil nil] - ["Fill Comment Paragraph" fill-paragraph t] - ["Fill Comment Paragraph Justify" - ada-fill-comment-paragraph-justify t] - ["Fill Comment Paragraph Postfix" - ada-fill-comment-paragraph-postfix t] - ["---" nil nil] - ["Adjust Case Selection" ada-adjust-case-region t] - ["Adjust Case in File" ada-adjust-case-buffer t] - ["Create Case Exception" ada-create-case-exception t] - ["Create Case Exception Substring" - ada-create-case-exception-substring t] - ["Reload Case Exceptions" ada-case-read-exceptions t] - ["----" nil nil] - ["Make body for subprogram" ada-make-subprogram-body t] - ["-----" nil nil] - ["Narrow to subprogram" ada-narrow-to-defun t]) - ("Templates" - :included (derived-mode-p 'ada-mode) - ["Header" ada-header t] - ["-" nil nil] - ["Package Body" ada-package-body t] - ["Package Spec" ada-package-spec t] - ["Function Spec" ada-function-spec t] - ["Procedure Spec" ada-procedure-spec t] - ["Proc/func Body" ada-subprogram-body t] - ["Task Body" ada-task-body t] - ["Task Spec" ada-task-spec t] - ["Declare Block" ada-declare-block t] - ["Exception Block" ada-exception-block t] - ["--" nil nil] - ["Entry" ada-entry t] - ["Entry family" ada-entry-family t] - ["Select" ada-select t] - ["Accept" ada-accept t] - ["Or accept" ada-or-accept t] - ["Or delay" ada-or-delay t] - ["Or terminate" ada-or-terminate t] - ["---" nil nil] - ["Type" ada-type t] - ["Private" ada-private t] - ["Subtype" ada-subtype t] - ["Record" ada-record t] - ["Array" ada-array t] - ["----" nil nil] - ["If" ada-if t] - ["Else" ada-else t] - ["Elsif" ada-elsif t] - ["Case" ada-case t] - ["-----" nil nil] - ["While Loop" ada-while-loop t] - ["For Loop" ada-for-loop t] - ["Loop" ada-loop t] - ["------" nil nil] - ["Exception" ada-exception t] - ["Exit" ada-exit t] - ["When" ada-when t]) - ))) - - (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode" m) - (if (featurep 'xemacs) - (progn - (define-key ada-mode-map [menu-bar] ada-mode-menu) - (setq mode-popup-menu (cons "Ada mode" ada-mode-menu)))))) - - -;; ------------------------------------------------------- -;; Commenting/Uncommenting code -;; The following two calls are provided to enhance the standard -;; comment-region function, which only allows uncommenting if the -;; comment is at the beginning of a line. If the line have been re-indented, -;; we are unable to use comment-region, which makes no sense. -;; -;; In addition, we provide an interface to the standard comment handling -;; function for justifying the comments. -;; ------------------------------------------------------- - -(when (or (<= emacs-major-version 20) (featurep 'xemacs)) - (defadvice comment-region (before ada-uncomment-anywhere disable) - (if (and (consp arg) ;; a prefix with \C-u is of the form '(4), whereas - ;; \C-u 2 sets arg to '2' (fixed by S.Leake) - (derived-mode-p 'ada-mode)) - (save-excursion - (let ((cs (concat "^[ \t]*" (regexp-quote comment-start)))) - (goto-char beg) - (while (re-search-forward cs end t) - (replace-match comment-start)) - ))))) - -(defun ada-uncomment-region (beg end &optional arg) - "Uncomment region BEG .. END. -ARG gives number of comment characters." - (interactive "r\nP") - - ;; This advice is not needed anymore with Emacs21. However, for older - ;; versions, as well as for XEmacs, we still need to enable it. - (if (or (<= emacs-major-version 20) (featurep 'xemacs)) - (progn - (ad-activate 'comment-region) - (comment-region beg end (- (or arg 2))) - (ad-deactivate 'comment-region)) - (comment-region beg end (list (- (or arg 2)))) - (ada-indent-region beg end))) - -(defun ada-fill-comment-paragraph-justify () - "Fill current comment paragraph and justify each line as well." - (interactive) - (ada-fill-comment-paragraph 'full)) - -(defun ada-fill-comment-paragraph-postfix () - "Fill current comment paragraph and justify each line as well. -Adds `ada-fill-comment-postfix' at the end of each line." - (interactive) - (ada-fill-comment-paragraph 'full t)) - -(defun ada-fill-comment-paragraph (&optional justify postfix) - "Fill the current comment paragraph. -If JUSTIFY is non-nil, each line is justified as well. -If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended -to each line filled and justified. -The paragraph is indented on the first line." - (interactive "P") - - ;; check if inside comment or just in front a comment - (if (and (not (ada-in-comment-p)) - (not (looking-at "[ \t]*--"))) - (error "Not inside comment")) - - (let* (indent from to - (opos (point-marker)) - - ;; Sets this variable to nil, otherwise it prevents - ;; fill-region-as-paragraph to work on Emacs <= 20.2 - (parse-sexp-lookup-properties nil) - - fill-prefix - (fill-column (current-fill-column))) - - ;; Find end of paragraph - (back-to-indentation) - (while (and (not (eobp)) (looking-at ".*--[ \t]*[^ \t\n]")) - (forward-line 1) - - ;; If we were at the last line in the buffer, create a dummy empty - ;; line at the end of the buffer. - (if (eobp) - (insert "\n") - (back-to-indentation))) - (beginning-of-line) - (setq to (point-marker)) - (goto-char opos) - - ;; Find beginning of paragraph - (back-to-indentation) - (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]")) - (forward-line -1) - (back-to-indentation)) - - ;; We want one line above the first one, unless we are at the beginning - ;; of the buffer - (unless (bobp) - (forward-line 1)) - (beginning-of-line) - (setq from (point-marker)) - - ;; Calculate the indentation we will need for the paragraph - (back-to-indentation) - (setq indent (current-column)) - ;; unindent the first line of the paragraph - (delete-region from (point)) - - ;; Remove the old postfixes - (goto-char from) - (while (re-search-forward "--\n" to t) - (replace-match "\n")) - - (goto-char (1- to)) - (setq to (point-marker)) - - ;; Indent and justify the paragraph - (setq fill-prefix ada-fill-comment-prefix) - (set-left-margin from to indent) - (if postfix - (setq fill-column (- fill-column (length ada-fill-comment-postfix)))) - - (fill-region-as-paragraph from to justify) - - ;; Add the postfixes if required - (if postfix - (save-restriction - (goto-char from) - (narrow-to-region from to) - (while (not (eobp)) - (end-of-line) - (insert-char ? (- fill-column (current-column))) - (insert ada-fill-comment-postfix) - (forward-line)) - )) - - ;; In Emacs <= 20.2 and XEmacs <=20.4, there is a bug, and a newline is - ;; inserted at the end. Delete it - (if (or (featurep 'xemacs) - (<= emacs-major-version 19) - (and (= emacs-major-version 20) - (<= emacs-minor-version 2))) - (progn - (goto-char to) - (end-of-line) - (delete-char 1))) - - (goto-char opos))) - - -;; --------------------------------------------------- -;; support for find-file.el -;; These functions are used by find-file to guess the file names from -;; unit names, and to find the other file (spec or body) from the current -;; file (body or spec). -;; It is also used to find in which function we are, so as to put the -;; cursor at the correct position. -;; Standard Ada does not force any relation between unit names and file names, -;; so some of these functions can only be a good approximation. However, they -;; are also overridden in `ada-xref'.el when we know that the user is using -;; GNAT. -;; --------------------------------------------------- - -;; Overridden when we work with GNAT, to use gnatkrunch -(defun ada-make-filename-from-adaname (adaname) - "Determine the filename in which ADANAME is found. -This matches the GNAT default naming convention, except for -pre-defined units." - (while (string-match "\\." adaname) - (setq adaname (replace-match "-" t t adaname))) - (downcase adaname) - ) - -(defun ada-other-file-name () - "Return the name of the other file. -The name returned is the body if `current-buffer' is the spec, -or the spec otherwise." - - (let ((is-spec nil) - (is-body nil) - (suffixes ada-spec-suffixes) - (name (buffer-file-name))) - - ;; Guess whether we have a spec or a body, and get the basename of the - ;; file. Since the extension may not start with '.', we can not use - ;; file-name-extension - (while (and (not is-spec) - suffixes) - (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name) - (setq is-spec t - name (match-string 1 name))) - (setq suffixes (cdr suffixes))) - - (if (not is-spec) - (progn - (setq suffixes ada-body-suffixes) - (while (and (not is-body) - suffixes) - (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name) - (setq is-body t - name (match-string 1 name))) - (setq suffixes (cdr suffixes))))) - - ;; If this wasn't in either list, return name itself - (if (not (or is-spec is-body)) - name - - ;; Else find the other possible names - (if is-spec - (setq suffixes ada-body-suffixes) - (setq suffixes ada-spec-suffixes)) - (setq is-spec name) - - (while suffixes - - ;; If we are using project file, search for the other file in all - ;; the possible src directories. - - (if (fboundp 'ada-find-src-file-in-dir) - (let ((other - (ada-find-src-file-in-dir - (file-name-nondirectory (concat name (car suffixes)))))) - (if other - (setq is-spec other))) - - ;; Else search in the current directory - (if (file-exists-p (concat name (car suffixes))) - (setq is-spec (concat name (car suffixes))))) - (setq suffixes (cdr suffixes))) - - is-spec))) - -(defun ada-which-function-are-we-in () - "Return the name of the function whose definition/declaration point is in. -Used in `ff-pre-load-hook'." - (setq ff-function-name nil) - (save-excursion - (end-of-line);; make sure we get the complete name - (or (if (re-search-backward ada-procedure-start-regexp nil t) - (setq ff-function-name (match-string 5))) - (if (re-search-backward ada-package-start-regexp nil t) - (setq ff-function-name (match-string 4)))) - )) - - -(defvar ada-last-which-function-line -1 - "Last line on which `ada-which-function' was called.") -(defvar ada-last-which-function-subprog 0 - "Last subprogram name returned by `ada-which-function'.") -(make-variable-buffer-local 'ada-last-which-function-subprog) -(make-variable-buffer-local 'ada-last-which-function-line) - - -(defun ada-which-function () - "Return the name of the function whose body the point is in. -This function works even in the case of nested subprograms, whereas the -standard Emacs function `which-function' does not. -Since the search can be long, the results are cached." - - (let ((line (count-lines 1 (point))) - (pos (point)) - end-pos - func-name indent - found) - - ;; If this is the same line as before, simply return the same result - (if (= line ada-last-which-function-line) - ada-last-which-function-subprog - - (save-excursion - ;; In case the current line is also the beginning of the body - (end-of-line) - - ;; Are we looking at "function Foo\n (paramlist)" - (skip-chars-forward " \t\n(") - - (condition-case nil - (up-list 1) - (error nil)) - - (skip-chars-forward " \t\n") - (if (looking-at "return") - (progn - (forward-word-strictly 1) - (skip-chars-forward " \t\n") - (skip-chars-forward "a-zA-Z0-9_'"))) - - ;; Can't simply do forward-word, in case the "is" is not on the - ;; same line as the closing parenthesis - (skip-chars-forward "is \t\n") - - ;; No look for the closest subprogram body that has not ended yet. - ;; Not that we expect all the bodies to be finished by "end ", - ;; or a simple "end;" indented in the same column as the start of - ;; the subprogram. The goal is to be as efficient as possible. - - (while (and (not found) - (re-search-backward ada-imenu-subprogram-menu-re nil t)) - - ;; Get the function name, but not the properties, or this changes - ;; the face in the mode line on Emacs 21 - (setq func-name (match-string-no-properties 3)) - (if (and (not (ada-in-comment-p)) - (not (save-excursion - (goto-char (match-end 0)) - (looking-at "[ \t\n]*new")))) - (save-excursion - (back-to-indentation) - (setq indent (current-column)) - (if (ada-search-ignore-string-comment - (concat "end[ \t]+" func-name "[ \t]*;\\|^" - (make-string indent ? ) "end;")) - (setq end-pos (point)) - (setq end-pos (point-max))) - (if (>= end-pos pos) - (setq found func-name)))) - ) - (setq ada-last-which-function-line line - ada-last-which-function-subprog found) - found)))) - -(defun ada-ff-other-window () - "Find other file in other window using `ff-find-other-file'." - (interactive) - (and (fboundp 'ff-find-other-file) - (ff-find-other-file t))) - -(defun ada-set-point-accordingly () - "Move to the function declaration that was set by `ff-which-function-are-we-in'." - (if ff-function-name - (progn - (goto-char (point-min)) - (unless (ada-search-ignore-string-comment - (concat ff-function-name "\\b") nil) - (goto-char (point-min)))))) - -(defun ada-get-body-name (&optional spec-name) - "Return the file name for the body of SPEC-NAME. -If SPEC-NAME is nil, return the body for the current package. -Return nil if no body was found." - (interactive) - - (unless spec-name (setq spec-name (buffer-file-name))) - - ;; Remove the spec extension. We can not simply remove the file extension, - ;; but we need to take into account the specific non-GNAT extensions that the - ;; user might have specified. - - (let ((suffixes ada-spec-suffixes) - end) - (while suffixes - (setq end (- (length spec-name) (length (car suffixes)))) - (if (string-equal (car suffixes) (substring spec-name end)) - (setq spec-name (substring spec-name 0 end))) - (setq suffixes (cdr suffixes)))) - - ;; If find-file.el was available, use its functions - (if (fboundp 'ff-get-file-name) - (ff-get-file-name ada-search-directories-internal - (ada-make-filename-from-adaname - (file-name-nondirectory - (file-name-sans-extension spec-name))) - ada-body-suffixes) - ;; Else emulate it very simply - (concat (ada-make-filename-from-adaname - (file-name-nondirectory - (file-name-sans-extension spec-name))) - ".adb"))) - - -;; --------------------------------------------------- -;; support for font-lock.el -;; Strings are a real pain in Ada because a single quote character is -;; overloaded as a string quote and type/instance delimiter. By default, a -;; single quote is given punctuation syntax in `ada-mode-syntax-table'. -;; So, for Font Lock mode purposes, we mark single quotes as having string -;; syntax when the gods that created Ada determine them to be. -;; -;; This only works in Emacs. See the comments before the grammar functions -;; at the beginning of this file for how this is done with XEmacs. -;; ---------------------------------------------------- - -(defconst ada-font-lock-syntactic-keywords - ;; Mark single quotes as having string quote syntax in 'c' instances. - ;; We used to explicitly avoid ''' as a special case for fear the buffer - ;; be highlighted as a string, but it seems this fear is unfounded. - ;; - ;; This sets the properties of the characters, so that ada-in-string-p - ;; correctly handles '"' too... - '(("[^a-zA-Z0-9)]\\('\\)[^\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?'))) - ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n))))) - -(defvar ada-font-lock-keywords - (eval-when-compile - (list - ;; - ;; handle "type T is access function return S;" - (list "\\<\\(function[ \t]+return\\)\\>" '(1 font-lock-keyword-face) ) - - ;; preprocessor line - (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-type-face t)) - - ;; - ;; accept, entry, function, package (body), protected (body|type), - ;; pragma, procedure, task (body) plus name. - (list (concat - "\\<\\(" - "accept\\|" - "entry\\|" - "function\\|" - "package[ \t]+body\\|" - "package\\|" - "pragma\\|" - "procedure\\|" - "protected[ \t]+body\\|" - "protected[ \t]+type\\|" - "protected\\|" - "task[ \t]+body\\|" - "task[ \t]+type\\|" - "task" - "\\)\\>[ \t]*" - "\\(\\sw+\\(\\.\\sw*\\)*\\)?") - '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t)) - ;; - ;; Optional keywords followed by a type name. - (list (concat ; ":[ \t]*" - "\\<\\(access[ \t]+all\\|access[ \t]+constant\\|access\\|constant\\|in[ \t]+reverse\\|\\|in[ \t]+out\\|in\\|out\\)\\>" - "[ \t]*" - "\\(\\sw+\\(\\.\\sw*\\)*\\)?") - '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t)) - - ;; - ;; Main keywords, except those treated specially below. - (concat "\\<" - (regexp-opt - '("abort" "abs" "abstract" "accept" "access" "aliased" "all" - "and" "array" "at" "begin" "case" "declare" "delay" "delta" - "digits" "do" "else" "elsif" "entry" "exception" "exit" "for" - "generic" "if" "in" "interface" "is" "limited" "loop" "mod" "not" - "null" "or" "others" "overriding" "private" "protected" "raise" - "range" "record" "rem" "renames" "requeue" "return" "reverse" - "select" "separate" "synchronized" "tagged" "task" "terminate" - "then" "until" "when" "while" "with" "xor") t) - "\\>") - ;; - ;; Anything following end and not already fontified is a body name. - '("\\<\\(end\\)\\>\\([ \t]+\\)?\\(\\(\\sw\\|[_.]\\)+\\)?" - (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) - ;; - ;; Keywords followed by a type or function name. - (list (concat "\\<\\(" - "new\\|of\\|subtype\\|type" - "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?") - '(1 font-lock-keyword-face) - '(2 (if (match-beginning 4) - font-lock-function-name-face - font-lock-type-face) nil t)) - ;; - ;; Keywords followed by a (comma separated list of) reference. - ;; Note that font-lock only works on single lines, thus we can not - ;; correctly highlight a with_clause that spans multiple lines. - (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)" - "[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W") - '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t)) - - ;; - ;; Goto tags. - '("<<\\(\\sw+\\)>>" 1 font-lock-constant-face) - - ;; Highlight based-numbers (R. Reagan ) - (list "\\([0-9]+#[[:xdigit:]_]+#\\)" '(1 font-lock-constant-face t)) - - ;; Ada unnamed numerical constants - (list "\\W\\([-+]?[0-9._]+\\)\\>" '(1 font-lock-constant-face)) - - )) - "Default expressions to highlight in Ada mode.") - - -;; --------------------------------------------------------- -;; Support for outline.el -;; --------------------------------------------------------- - -(defun ada-outline-level () - "This is so that `current-column' DTRT in otherwise-hidden text." - ;; patch from Dave Love - (let (buffer-invisibility-spec) - (save-excursion - (back-to-indentation) - (current-column)))) - -;; --------------------------------------------------------- -;; Support for narrow-to-region -;; --------------------------------------------------------- - -(defun ada-narrow-to-defun (&optional _arg) - "Make text outside current subprogram invisible. -The subprogram visible is the one that contains or follow point. -Optional ARG is ignored. -Use \\[widen] to go back to the full visibility for the buffer." - - (interactive) - (save-excursion - (let (end) - (widen) - (forward-line 1) - (ada-previous-procedure) - (setq end (point-at-bol)) - (ada-move-to-end) - (end-of-line) - (narrow-to-region end (point)) - (message - "Use M-x widen to get back to full visibility in the buffer")))) - -;; --------------------------------------------------------- -;; Automatic generation of code -;; The Ada mode has a set of function to automatically generate a subprogram -;; or package body from its spec. -;; These function only use a primary and basic algorithm, this could use a -;; lot of improvement. -;; When the user is using GNAT, we rather use gnatstub to generate an accurate -;; body. -;; ---------------------------------------------------------- - -(defun ada-gen-treat-proc (match) - "Make dummy body of a procedure/function specification. -MATCH is a cons cell containing the start and end locations of the last search -for `ada-procedure-start-regexp'." - (goto-char (car match)) - (let (func-found procname functype) - (cond - ((or (looking-at "^[ \t]*procedure") - (setq func-found (looking-at "^[ \t]*function"))) - ;; treat it as a proc/func - (forward-word-strictly 2) - (forward-word-strictly -1) - (setq procname (buffer-substring (point) (cdr match))) ; store proc name - - ;; goto end of procname - (goto-char (cdr match)) - - ;; skip over parameterlist - (unless (looking-at "[ \t\n]*\\(;\\|return\\)") - (forward-sexp)) - - ;; if function, skip over 'return' and result type. - (if func-found - (progn - (forward-word-strictly 1) - (skip-chars-forward " \t\n") - (setq functype (buffer-substring (point) - (progn - (skip-chars-forward - "a-zA-Z0-9_.") - (point)))))) - ;; look for next non WS - (cond - ((looking-at "[ \t]*;") - (delete-region (match-beginning 0) (match-end 0));; delete the ';' - (ada-indent-newline-indent) - (insert "is") - (ada-indent-newline-indent) - (if func-found - (progn - (insert "Result : " functype ";") - (ada-indent-newline-indent))) - (insert "begin") - (ada-indent-newline-indent) - (if func-found - (insert "return Result;") - (insert "null;")) - (ada-indent-newline-indent) - (insert "end " procname ";") - (ada-indent-newline-indent) - ) - - ((looking-at "[ \t\n]*is") - ;; do nothing - ) - - ((looking-at "[ \t\n]*rename") - ;; do nothing - ) - - (t - (message "unknown syntax")))) - (t - (if (looking-at "^[ \t]*task") - (progn - (message "Task conversion is not yet implemented") - (forward-word-strictly 2) - (if (looking-at "[ \t]*;") - (forward-line) - (ada-move-to-end)) - )))))) - -(defun ada-make-body () - "Create an Ada package body in the current buffer. -The spec must be the previously visited buffer. -This function typically is to be hooked into `ff-file-created-hook'." - (delete-region (point-min) (point-max)) - (insert-buffer-substring (car (cdr (buffer-list)))) - (goto-char (point-min)) - (ada-mode) - - (let (found ada-procedure-or-package-start-regexp) - (if (setq found - (ada-search-ignore-string-comment ada-package-start-regexp nil)) - (progn (goto-char (cdr found)) - (insert " body") - ) - (error "No package")) - - (setq ada-procedure-or-package-start-regexp - (concat ada-procedure-start-regexp - "\\|" - ada-package-start-regexp)) - - (while (setq found - (ada-search-ignore-string-comment - ada-procedure-or-package-start-regexp nil)) - (progn - (goto-char (car found)) - (if (looking-at ada-package-start-regexp) - (progn (goto-char (cdr found)) - (insert " body")) - (ada-gen-treat-proc found)))))) - - -(defun ada-make-subprogram-body () - "Create a dummy subprogram body in package body file from spec surrounding point." - (interactive) - (let* ((found (re-search-backward ada-procedure-start-regexp nil t)) - (spec (match-beginning 0)) - body-file) - (if found - (progn - (goto-char spec) - (if (and (re-search-forward "(\\|;" nil t) - (= (char-before) ?\()) - (progn - (ada-search-ignore-string-comment ")" nil) - (ada-search-ignore-string-comment ";" nil))) - (setq spec (buffer-substring spec (point))) - - ;; If find-file.el was available, use its functions - (setq body-file (ada-get-body-name)) - (if body-file - (find-file body-file) - (error "No body found for the package. Create it first")) - - (save-restriction - (widen) - (goto-char (point-max)) - (forward-comment -10000) - (re-search-backward "\\" nil t) - ;; Move to the beginning of the elaboration part, if any - (re-search-backward "^begin" nil t) - (newline) - (forward-char -1) - (insert spec) - (re-search-backward ada-procedure-start-regexp nil t) - (ada-gen-treat-proc (cons (match-beginning 0) (match-end 0))) - )) - (error "Not in subprogram spec")))) - -;; -------------------------------------------------------- -;; Global initializations -;; -------------------------------------------------------- - -;; Create the keymap once and for all. If we do that in ada-mode, -;; the keys changed in the user's .emacs have to be modified -;; every time -(ada-create-keymap) -(ada-create-menu) - -;; Add the default extensions (and set up speedbar) -(ada-add-extensions ".ads" ".adb") -;; This two files are generated by GNAT when running with -gnatD -(if (equal ada-which-compiler 'gnat) - (ada-add-extensions ".ads.dg" ".adb.dg")) - -;; Read the special cases for exceptions -(ada-case-read-exceptions) - -;; Setup auto-loading of the other Ada mode files. -(autoload 'ada-change-prj "ada-xref" nil t) -(autoload 'ada-check-current "ada-xref" nil t) -(autoload 'ada-compile-application "ada-xref" nil t) -(autoload 'ada-compile-current "ada-xref" nil t) -(autoload 'ada-complete-identifier "ada-xref" nil t) -(autoload 'ada-find-file "ada-xref" nil t) -(autoload 'ada-find-any-references "ada-xref" nil t) -(autoload 'ada-find-src-file-in-dir "ada-xref" nil t) -(autoload 'ada-find-local-references "ada-xref" nil t) -(autoload 'ada-find-references "ada-xref" nil t) -(autoload 'ada-gdb-application "ada-xref" nil t) -(autoload 'ada-goto-declaration "ada-xref" nil t) -(autoload 'ada-goto-declaration-other-frame "ada-xref" nil t) -(autoload 'ada-goto-parent "ada-xref" nil t) -(autoload 'ada-make-body-gnatstub "ada-xref" nil t) -(autoload 'ada-point-and-xref "ada-xref" nil t) -(autoload 'ada-reread-prj-file "ada-xref" nil t) -(autoload 'ada-run-application "ada-xref" nil t) -(autoload 'ada-set-default-project-file "ada-xref" nil t) -(autoload 'ada-xref-goto-previous-reference "ada-xref" nil t) -(autoload 'ada-set-main-compile-application "ada-xref" nil t) -(autoload 'ada-show-current-main "ada-xref" nil t) - -(autoload 'ada-customize "ada-prj" nil t) -(autoload 'ada-prj-edit "ada-prj" nil t) -(autoload 'ada-prj-new "ada-prj" nil t) -(autoload 'ada-prj-save "ada-prj" nil t) - -(autoload 'ada-array "ada-stmt" nil t) -(autoload 'ada-case "ada-stmt" nil t) -(autoload 'ada-declare-block "ada-stmt" nil t) -(autoload 'ada-else "ada-stmt" nil t) -(autoload 'ada-elsif "ada-stmt" nil t) -(autoload 'ada-exception "ada-stmt" nil t) -(autoload 'ada-exception-block "ada-stmt" nil t) -(autoload 'ada-exit "ada-stmt" nil t) -(autoload 'ada-for-loop "ada-stmt" nil t) -(autoload 'ada-function-spec "ada-stmt" nil t) -(autoload 'ada-header "ada-stmt" nil t) -(autoload 'ada-if "ada-stmt" nil t) -(autoload 'ada-loop "ada-stmt" nil t) -(autoload 'ada-package-body "ada-stmt" nil t) -(autoload 'ada-package-spec "ada-stmt" nil t) -(autoload 'ada-private "ada-stmt" nil t) -(autoload 'ada-procedure-spec "ada-stmt" nil t) -(autoload 'ada-record "ada-stmt" nil t) -(autoload 'ada-subprogram-body "ada-stmt" nil t) -(autoload 'ada-subtype "ada-stmt" nil t) -(autoload 'ada-tabsize "ada-stmt" nil t) -(autoload 'ada-task-body "ada-stmt" nil t) -(autoload 'ada-task-spec "ada-stmt" nil t) -(autoload 'ada-type "ada-stmt" nil t) -(autoload 'ada-use "ada-stmt" nil t) -(autoload 'ada-when "ada-stmt" nil t) -(autoload 'ada-while-loop "ada-stmt" nil t) -(autoload 'ada-with "ada-stmt" nil t) - -;;; provide ourselves -(provide 'ada-mode) - -;;; ada-mode.el ends here diff --git a/old_ada/ada-prj.el b/old_ada/ada-prj.el deleted file mode 100644 index d9fa77c..0000000 --- a/old_ada/ada-prj.el +++ /dev/null @@ -1,682 +0,0 @@ -;;; ada-prj.el --- GUI editing of project files for the ada-mode - -;; Copyright (C) 1998-2019 Free Software Foundation, Inc. - -;; Author: Emmanuel Briot -;; Maintainer: Stephen Leake -;; Keywords: languages, ada, project file -;; Package: ada-mode - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This package provides a set of functions to easily edit the project -;; files used by the ada-mode. -;; The only function publicly available here is `ada-customize'. -;; See the documentation of the Ada mode for more information on the project -;; files. -;; Internally, a project file is represented as a property list, with each -;; field of the project file matching one property of the list. - -;;; Code: - - -;; ----- Requirements ----------------------------------------------------- - -(require 'cus-edit) -(require 'ada-xref) - -(eval-when-compile - (require 'ada-mode)) -(eval-when-compile (require 'cl-lib)) - -;; ----- Buffer local variables ------------------------------------------- - -(defvar ada-prj-current-values nil - "Hold the current value of the fields, This is a property list.") -(make-variable-buffer-local 'ada-prj-current-values) - -(defvar ada-prj-default-values nil - "Hold the default value for the fields, This is a property list.") -(make-variable-buffer-local 'ada-prj-default-values) - -(defvar ada-prj-ada-buffer nil - "Indicates what Ada source file was being edited.") - -(defvar ada-old-cross-prefix nil - "The cross-prefix associated with the currently loaded runtime library.") - - -;; ----- Functions -------------------------------------------------------- - -(defun ada-prj-new () - "Open a new project file." - (interactive) - (let* ((prj - (if (and ada-prj-default-project-file - (not (string= ada-prj-default-project-file ""))) - ada-prj-default-project-file - "default.adp")) - (filename (read-file-name "Project file: " - (if prj "" nil) - nil - nil - prj))) - (if (not (string= (file-name-extension filename t) ".adp")) - (error "File name extension for project files must be .adp")) - - (ada-customize nil filename))) - -(defun ada-prj-edit () - "Editing the project file associated with the current Ada buffer. -If there is none, opens a new project file." - (interactive) - (if ada-prj-default-project-file - (ada-customize) - (ada-prj-new))) - -(defun ada-prj-initialize-values (symbol _ada-buffer filename) - "Set SYMBOL to the property list of the project file FILENAME. -If FILENAME is null, read the file associated with ADA-BUFFER. -If no project file is found, return the default values." -;; FIXME: rationalize arguments; make ada-buffer optional? - (if (and filename - (not (string= filename "")) - (assoc filename ada-xref-project-files)) - (set symbol (copy-sequence (cdr (assoc filename ada-xref-project-files)))) - - ;; Set default values (except for the file name if this was given - ;; in the buffer - (set symbol (ada-default-prj-properties)) - (if (and filename (not (string= filename ""))) - (set symbol (plist-put (eval symbol) 'filename filename))) - )) - - -(defun ada-prj-save-specific-option (field) - "Return the string to print in the project file to save FIELD. -If the current value of FIELD is the default value, return an empty string." - (if (string= (plist-get ada-prj-current-values field) - (plist-get ada-prj-default-values field)) - "" - (concat (symbol-name field) - "=" (plist-get ada-prj-current-values field) "\n"))) - -(defun ada-prj-save () - "Save the edited project file." - (interactive) - (let ((file-name (or (plist-get ada-prj-current-values 'filename) - (read-file-name "Save project as: "))) - output) - (setq output - (concat - - ;; Save the fields that do not depend on the current buffer - ;; only if they are different from the default value - - (ada-prj-save-specific-option 'comp_opt) - (ada-prj-save-specific-option 'bind_opt) - (ada-prj-save-specific-option 'link_opt) - (ada-prj-save-specific-option 'gnatmake_opt) - (ada-prj-save-specific-option 'gnatfind_opt) - (ada-prj-save-specific-option 'cross_prefix) - (ada-prj-save-specific-option 'remote_machine) - (ada-prj-save-specific-option 'debug_cmd) - - ;; Always save the fields that depend on the current buffer - "main=" (plist-get ada-prj-current-values 'main) "\n" - "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n" - (ada-prj-set-list "check_cmd" - (plist-get ada-prj-current-values 'check_cmd)) "\n" - (ada-prj-set-list "make_cmd" - (plist-get ada-prj-current-values 'make_cmd)) "\n" - (ada-prj-set-list "comp_cmd" - (plist-get ada-prj-current-values 'comp_cmd)) "\n" - (ada-prj-set-list "run_cmd" - (plist-get ada-prj-current-values 'run_cmd)) "\n" - (ada-prj-set-list "src_dir" - (plist-get ada-prj-current-values 'src_dir) - t) "\n" - (ada-prj-set-list "obj_dir" - (plist-get ada-prj-current-values 'obj_dir) - t) "\n" - (ada-prj-set-list "debug_pre_cmd" - (plist-get ada-prj-current-values 'debug_pre_cmd)) - "\n" - (ada-prj-set-list "debug_post_cmd" - (plist-get ada-prj-current-values 'debug_post_cmd)) - "\n" - )) - - (find-file file-name) - (erase-buffer) - (insert output) - (save-buffer) - ;; kill the project buffer - (kill-buffer nil) - - ;; kill the editor buffer - (kill-buffer "*Edit Ada Mode Project*") - - ;; automatically set the new project file as the active one - (setq ada-prj-default-project-file file-name) - - ;; force Emacs to reread the project files - (ada-reread-prj-file file-name) - ) - ) - -(defun ada-prj-load-from-file (symbol) - "Load SYMBOL value from file. -One item per line should be found in the file." - (save-excursion - (let ((file (read-file-name "File name: " nil nil t)) - (buffer (current-buffer)) - line - list) - (find-file file) - (widen) - (goto-char (point-min)) - (while (not (eobp)) - (setq line (buffer-substring-no-properties (point) (point-at-eol))) - (cl-pushnew line list :test #'equal) - (forward-line 1)) - (kill-buffer nil) - (set-buffer buffer) - (setq ada-prj-current-values - (plist-put ada-prj-current-values - symbol - (append (plist-get ada-prj-current-values symbol) - (reverse list))))) - (ada-prj-display-page 2))) - -(defun ada-prj-subdirs-of (dir) - "Return a list of all the subdirectories of DIR, recursively." - (let ((subdirs (directory-files dir t "^[^.].*")) - (dirlist (list dir))) - (while subdirs - (if (file-directory-p (car subdirs)) - (let ((sub (ada-prj-subdirs-of (car subdirs)))) - (if sub - (setq dirlist (append sub dirlist))))) - (setq subdirs (cdr subdirs))) - dirlist)) - -(defun ada-prj-load-directory (field &optional file-name) - "Append to FIELD in the current project the subdirectories of FILE-NAME. -If FILE-NAME is nil, ask the user for the name." - - ;; Do not use an external dialog for this, since it wouldn't allow - ;; the user to select a directory - (let ((use-dialog-box nil)) - (unless file-name - (setq file-name (read-directory-name "Root directory: " nil nil t)))) - - (setq ada-prj-current-values - (plist-put ada-prj-current-values - field - (append (plist-get ada-prj-current-values field) - (reverse (ada-prj-subdirs-of - (expand-file-name file-name)))))) - (ada-prj-display-page 2)) - -(defun ada-prj-display-page (tab-num) - "Display page TAB-NUM in the notebook. -The current buffer must be the project editing buffer." - - (let ((inhibit-read-only t)) - (erase-buffer)) - - ;; Widget support in Emacs 21 requires that we clear the buffer first - (if (and (not (featurep 'xemacs)) (>= emacs-major-version 21)) - (progn - (setq widget-field-new nil - widget-field-list nil) - (mapc (lambda (x) (delete-overlay x)) (car (overlay-lists))) - (mapc (lambda (x) (delete-overlay x)) (cdr (overlay-lists))))) - - ;; Display the tabs - - (widget-insert "\n Project configuration.\n - ___________ ____________ ____________ ____________ ____________\n / ") - (widget-create 'push-button :notify - (lambda (&rest _dummy) (ada-prj-display-page 1)) "General") - (widget-insert " \\ / ") - (widget-create 'push-button :notify - (lambda (&rest _dummy) (ada-prj-display-page 2)) "Paths") - (widget-insert " \\ / ") - (widget-create 'push-button :notify - (lambda (&rest _dummy) (ada-prj-display-page 3)) "Switches") - (widget-insert " \\ / ") - (widget-create 'push-button :notify - (lambda (&rest _dummy) (ada-prj-display-page 4)) "Ada Menu") - (widget-insert " \\ / ") - (widget-create 'push-button :notify - (lambda (&rest _dummy) (ada-prj-display-page 5)) "Debugger") - (widget-insert " \\\n") - - ;; Display the currently selected page - - (cond - - ;; - ;; First page (General) - ;; - ((= tab-num 1) - (widget-insert "/ \\/______________\\/______________\\/______________\\/______________\\\n") - - (widget-insert "Project file name:\n") - (widget-insert (plist-get ada-prj-current-values 'filename)) - (widget-insert "\n\n") - (ada-prj-field 'casing "Casing Exceptions" -"List of files that contain casing exception -dictionaries. All these files contain one -identifier per line, with a special casing. -The first file has the highest priority." - t nil - (mapconcat (lambda(x) - (concat " " x)) - (ada-xref-get-project-field 'casing) - "\n") - ) - (ada-prj-field 'main "Executable file name" -"Name of the executable generated when you -compile your application. This should include -the full directory name, using ${build_dir} if -you wish.") - (ada-prj-field 'build_dir "Build directory" - "Reference directory for relative paths in -src_dir and obj_dir below. This is also the directory -where the compilation is done.") - (ada-prj-field 'remote_machine "Name of the remote machine (if any)" -"If you want to remotely compile, debug and -run your application, specify the name of a -remote machine here. This capability requires -the `rsh' protocol on the remote machine.") - (ada-prj-field 'cross_prefix "Prefix used in for the cross tool chain" -"When working on multiple cross targets, it is -most convenient to specify the prefix of the -tool chain here. For instance, on PowerPc -vxworks, you would enter `powerpc-wrs-vxworks-'. -To use JGNAT, enter `j'.") - ) - - - ;; - ;; Second page (Paths) - ;; - ((= tab-num 2) - (if (not (equal (plist-get ada-prj-current-values 'cross_prefix) - ada-old-cross-prefix)) - (progn - (setq ada-old-cross-prefix - (plist-get ada-prj-current-values 'cross_prefix)) - (ada-initialize-runtime-library ada-old-cross-prefix))) - - - (widget-insert "/_____________\\/ \\/______________\\/______________\\/______________\\\n") - (ada-prj-field 'src_dir "Source directories" -"Enter the list of directories where your Ada -sources can be found. These directories will be -used for the cross-references and for the default -compilation commands. -Note that src_dir includes both the build directory -and the standard runtime." - t t - (mapconcat (lambda(x) - (concat " " x)) - ada-xref-runtime-library-specs-path - "\n") - ) - (widget-insert "\n\n") - - (ada-prj-field 'obj_dir "Object directories" -"Enter the list of directories where the GNAT -library files (ALI files) can be found. These -files are used for cross-references and by the -gnatmake command. -Note that obj_dir includes both the build directory -and the standard runtime." - t t - (mapconcat (lambda(x) - (concat " " x)) - ada-xref-runtime-library-ali-path - "\n") - ) - (widget-insert "\n\n") - ) - - ;; - ;; Third page (Switches) - ;; - ((= tab-num 3) - (widget-insert "/_____________\\/______________\\/ \\/______________\\/______________\\\n") - (ada-prj-field 'comp_opt "Switches for the compiler" -"These switches are used in the default -compilation commands, both for compiling a -single file and rebuilding the whole project") - (ada-prj-field 'bind_opt "Switches for the binder" -"These switches are used in the default build -command and are passed to the binder") - (ada-prj-field 'link_opt "Switches for the linker" -"These switches are used in the default build -command and are passed to the linker") - (ada-prj-field 'gnatmake_opt "Switches for gnatmake" -"These switches are used in the default gnatmake -command.") - (ada-prj-field 'gnatfind_opt "Switches for gnatfind" -"The command gnatfind is run every time the Ada/Goto/List_References menu. -You should for instance add -a if you are working in an environment -where most ALI files are write-protected, since otherwise they get -ignored by gnatfind and you don't see the references within.") - ) - - ;; - ;; Fourth page - ;; - ((= tab-num 4) - (widget-insert "/_____________\\/______________\\/______________\\/ \\/______________\\\n") - (widget-insert -"All the fields below can use variable substitution. The syntax is ${name}, -where name is the name that appears after the Help buttons in this buffer. As -a special case, ${current} is replaced with the name of the file currently -edited, with directory name but no extension, whereas ${full_current} is -replaced with the name of the current file with directory name and -extension.\n") - (widget-insert -"The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are set to -${src_dir} and ${obj_dir} before running the compilation commands, so that you -don't need to specify the -aI and -aO switches on the command line\n") - (widget-insert -"You can reference any environment variable using the same ${...} syntax as -above, and put the name of the variable between the quotes.\n\n") - (ada-prj-field 'check_cmd - "Check syntax of a single file (menu Ada->Check File)" -"This command is run to check the syntax and semantics of a file. -The file name is added at the end of this command." t) - (ada-prj-field 'comp_cmd - "Compiling a single file (menu Ada->Compile File)" -"This command is run when the recompilation -of a single file is needed. The file name is -added at the end of this command." t) - (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)" -"This command is run when you want to rebuild -your whole application. It is never issues -automatically and you will need to ask for it. -If remote_machine has been set, this command -will be executed on the remote machine." t) - (ada-prj-field 'run_cmd "Running the application (menu Ada->Run)" -"This command specifies how to run the -application, including any switch you need to -specify. If remote_machine has been set, this -command will be executed on the remote host." t) - ) - - ;; - ;; Fifth page - ;; - ((= tab-num 5) - (widget-insert "/_____________\\/______________\\/______________\\/______________\\/ \\\n") - (ada-prj-field 'debug_pre_cmd "Commands to execute before launching the -debugger" -"The following commands are executed one after the other before starting -the debugger. These can be used to set up your environment." t) - - (ada-prj-field 'debug_cmd "Debugging the application" -"Specifies how to debug the application, possibly -remotely if remote_machine has been set. We -recommend the following debuggers: - > gdb - > gvd --tty - > ddd --tty -fullname -toolbar") - - (ada-prj-field 'debug_post_cmd "Commands to execute in the debugger" -"The following commands are executed one in the debugger once it has been -started. These can be used to initialize the debugger, for instance to -connect to the target when working with cross-environments" t) - ) - - ) - - - (widget-insert "______________________________________________________________________\n\n ") - (widget-create 'push-button - :notify (lambda (&rest _ignore) - (setq ada-prj-current-values (ada-default-prj-properties)) - (ada-prj-display-page 1)) - "Reset to Default Values") - (widget-insert " ") - (widget-create 'push-button :notify (lambda (&rest _ignore) (kill-buffer nil)) - "Cancel") - (widget-insert " ") - (widget-create 'push-button :notify (lambda (&rest _ignore) (ada-prj-save)) - "Save") - (widget-insert "\n\n") - - (widget-setup) - (with-no-warnings - (beginning-of-buffer)) - ) - - -(defun ada-customize (&optional new-file filename) - "Edit the project file associated with the current buffer. -If there is none or NEW-FILE is non-nil, make a new one. -If FILENAME is given, edit that file." - (interactive) - - (let ((ada-buffer (current-buffer)) - (inhibit-read-only t)) - - ;; We can only edit interactively the standard ada-mode project files. If - ;; the user is using other formats for the project file (through hooks in - ;; `ada-load-project-hook', we simply edit the file - - (if (and (not new-file) - (or ada-prj-default-project-file filename) - (string= (file-name-extension - (or filename ada-prj-default-project-file)) - "gpr")) - (progn - (find-file ada-prj-default-project-file) - (add-hook 'after-save-hook 'ada-reread-prj-file t t) - ) - - (if filename - (ada-reread-prj-file filename) - (if (not (string= ada-prj-default-project-file "")) - (ada-reread-prj-file ada-prj-default-project-file) - (ada-reread-prj-file))) - - (switch-to-buffer "*Edit Ada Mode Project*") - - (ada-prj-initialize-values 'ada-prj-current-values - ada-buffer - ada-prj-default-project-file) - - (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer) - - (use-local-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map custom-mode-map) - (define-key map "\C-x\C-s" 'ada-prj-save) - map)) - - ;; FIXME: Not sure if this works!! - (set (make-local-variable 'widget-keymap) - (let ((map (make-sparse-keymap))) - (set-keymap-parent map widget-keymap) - (define-key map "\C-x\C-s" 'ada-prj-save) - map)) - - (set (make-local-variable 'ada-old-cross-prefix) - (ada-xref-get-project-field 'cross-prefix)) - - (ada-prj-display-page 1) - ))) - -;; ---------------- Utilities -------------------------------- - -(defun ada-prj-set-list (string ada-list &optional is-directory) - "Prepend STRING to strings in ADA-LIST, return new-line separated string. -If IS-DIRECTORY is non-nil, each element of ADA-LIST is explicitly -converted to a directory name." - - (mapconcat (lambda (x) (concat string "=" - (if is-directory - (file-name-as-directory x) - x))) - ada-list "\n")) - - -(defun ada-prj-field-modified (widget &rest _dummy) - "Callback for modification of WIDGET. -Remaining args DUMMY are ignored. -Save the change in `ada-prj-current-values' so that selecting -another page and coming back keeps the new value." - (setq ada-prj-current-values - (plist-put ada-prj-current-values - (widget-get widget ':prj-field) - (widget-value widget)))) - -(defun ada-prj-display-help (widget _widget-modified event) - "Callback for help button in WIDGET. -Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." - (let ((text (widget-get widget 'prj-help))) - (if event - ;; If we have a mouse-event, popup a menu - (widget-choose "Help" - (mapcar (lambda (a) (cons a t)) - (split-string text "\n")) - event) - ;; Else display the help string just before the next group of - ;; variables - (momentary-string-display - (concat "*****Help*****\n" text "\n**************\n") - (point-at-bol 2))))) - -(defun ada-prj-show-value (widget _widget-modified event) - "Show the current field value in WIDGET. -Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." - (let* ((field (widget-get widget ':prj-field)) - (value (plist-get ada-prj-current-values field)) - (inhibit-read-only t) - w) - - ;; If the other widget is already visible, delete it - (if (widget-get widget 'prj-other-widget) - (progn - (widget-delete (widget-get widget 'prj-other-widget)) - (widget-put widget 'prj-other-widget nil) - (widget-put widget ':prj-field field) - (widget-default-value-set widget "Show Value") - ) - - ;; Else create it - (save-excursion - (mouse-set-point event) - (forward-line 1) - (beginning-of-line) - (setq w (widget-create 'editable-list - :entry-format "%i%d %v" - :notify 'ada-prj-field-modified - :help-echo (widget-get widget 'prj-help) - :value value - (list 'editable-field :keymap widget-keymap))) - (widget-put widget 'prj-other-widget w) - (widget-put w ':prj-field field) - (widget-put widget ':prj-field field) - (widget-default-value-set widget "Hide Value") - ) - ) - (widget-setup) - )) - -(defun ada-prj-field (field text help-text &optional is-list is-paths after-text) - "Create a widget to edit FIELD in the current buffer. -TEXT is a short explanation of what the field means, whereas HELP-TEXT -is the text displayed when the user pressed the help button. -If IS-LIST is non-nil, the field contains a list. Otherwise, it contains -a single string. -If IS-PATHS is true, some special buttons are added to load paths,... -AFTER-TEXT is inserted just after the widget." - (let ((value (plist-get ada-prj-current-values field)) - (inhibit-read-only t) - widget) - (unless value - (setq value - (if is-list '() ""))) - (widget-insert text) - (widget-insert ":") - (move-to-column 54 t) - (widget-put (widget-create 'push-button - :notify 'ada-prj-display-help - "Help") - 'prj-help - help-text) - (widget-insert (concat " (" (symbol-name field) ")\n")) - (if is-paths - (progn - (widget-create 'push-button - :notify - (list 'lambda '(&rest dummy) '(interactive) - (list 'ada-prj-load-from-file - (list 'quote field))) - "Load From File") - (widget-insert " ") - (widget-create 'push-button - :notify - (list 'lambda '(&rest dummy) '(interactive) - (list 'ada-prj-load-directory - (list 'quote field))) - "Load Recursive Directory") - (widget-insert "\n ${build_dir}\n"))) - - (setq widget - (if is-list - (if (< (length value) 15) - (widget-create 'editable-list - :entry-format "%i%d %v" - :notify 'ada-prj-field-modified - :help-echo help-text - :value value - (list 'editable-field :keymap widget-keymap)) - - (let ((w (widget-create 'push-button - :notify 'ada-prj-show-value - "Show value"))) - (widget-insert "\n") - (widget-put w 'prj-help help-text) - (widget-put w 'prj-other-widget nil) - w) - ) - (widget-create 'editable-field - :format "%v" - :notify 'ada-prj-field-modified - :help-echo help-text - :keymap widget-keymap - value))) - (widget-put widget ':prj-field field) - (if after-text - (widget-insert after-text)) - (widget-insert "\n") - )) - - -(provide 'ada-prj) - -;;; ada-prj.el ends here diff --git a/old_ada/ada-stmt.el b/old_ada/ada-stmt.el deleted file mode 100644 index ef42b0d..0000000 --- a/old_ada/ada-stmt.el +++ /dev/null @@ -1,486 +0,0 @@ -;;; ada-stmt.el --- an extension to Ada mode for inserting statement templates - -;; Copyright (C) 1987, 1993-1994, 1996-2019 Free Software Foundation, -;; Inc. - -;; Authors: Daniel Pfeiffer -;; Markus Heritsch -;; Rolf Ebert -;; Maintainer: Stephen Leake -;; Keywords: languages, ada -;; Package: ada-mode - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; This file is now automatically loaded from ada-mode.el, and creates a submenu -;; in Ada/ on the menu bar. - -;;; History: - -;; Created May 1987. -;; Original version from V. Bowman as in ada.el of Emacs-18 -;; (borrowed heavily from Mick Jordan's Modula-2 package for GNU, -;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.) -;; -;; Sep 1993. Daniel Pfeiffer (DP) -;; Introduced statement.el for smaller code and user configurability. -;; -;; Nov 1993. Rolf Ebert (RE) Moved the -;; skeleton generation into this separate file. The code still is -;; essentially written by DP -;; -;; Adapted Jun 1994. Markus Heritsch -;; (MH) -;; added menu bar support for templates -;; -;; 1994/12/02 Christian Egli -;; General cleanup and bug fixes. -;; -;; 1995/12/20 John Hutchison -;; made it work with skeleton.el from Emacs-19.30. Several -;; enhancements and bug fixes. - -;; BUGS: -;;;> I have the following suggestions for the function template: 1) I -;;;> don't want it automatically assigning it a name for the return variable. I -;;;> never want it to be called "Result" because that is nondescript. If you -;;;> must define a variable, give me the ability to specify its name. -;;;> -;;;> 2) You do not provide a type for variable 'Result'. Its type is the same -;;;> as the function's return type, which the template knows, so why force me -;;;> to type it in? -;;;> - -;;;It would be nice if one could configure such layout details separately -;;;without patching the LISP code. Maybe the metalanguage used in ada-stmt.el -;;;could be taken even further, providing the user with some nice syntax -;;;for describing layout. Then my own hacks would survive the next -;;;update of the package :-) - - -;;; Code: - -(require 'skeleton nil t) -(require 'easymenu) -(require 'ada-mode) - -(defun ada-func-or-proc-name () - "Return the name of the current function or procedure." - (save-excursion - (let ((case-fold-search t)) - (if (re-search-backward ada-procedure-start-regexp nil t) - (match-string 5) - "NAME?")))) - -;;; ---- statement skeletons ------------------------------------------ - -(define-skeleton ada-array - "Insert array type definition. -Prompt for component type and index subtypes." - () - "array (" ("index definition: " str ", " ) -2 ") of " _ ?\;) - - -(define-skeleton ada-case - "Build skeleton case statement. -Prompt for the selector expression. Also builds the first when clause." - "[selector expression]: " - "case " str " is" \n - > "when " ("discrete choice: " str " | ") -3 " =>" \n - > _ \n - < < "end case;") - - -(define-skeleton ada-when - "Start a case statement alternative with a when clause." - () - < "when " ("discrete choice: " str " | ") -3 " =>" \n - >) - - -(define-skeleton ada-declare-block - "Insert a block with a declare part. -Indent for the first declaration." - "[block name]: " - < str & ?: & \n - > "declare" \n - > _ \n - < "begin" \n - > \n - < "end " str | -1 ?\;) - - -(define-skeleton ada-exception-block - "Insert a block with an exception part. -Indent for the first line of code." - "[block name]: " - < str & ?: & \n - > "begin" \n - > _ \n - < "exception" \n - > \n - < "end " str | -1 ?\;) - - -(define-skeleton ada-exception - "Insert an indented exception part into a block." - () - < "exception" \n - >) - - -(define-skeleton ada-exit-1 - "Insert then exit condition of the exit statement, prompting for condition." - "[exit condition]: " - "when " str | -5) - - -(define-skeleton ada-exit - "Insert an exit statement, prompting for loop name and condition." - "[name of loop to exit]: " - "exit " str & ?\ (ada-exit-1) | -1 ?\;) - -;;;###autoload -(defun ada-header () - "Insert a descriptive header at the top of the file." - (interactive "*") - (save-excursion - (goto-char (point-min)) - (if (fboundp 'make-header) - (funcall (symbol-function 'make-header)) - (ada-header-tmpl)))) - - -(define-skeleton ada-header-tmpl - "Insert a comment block containing the module title, author, etc." - "[Description]: " - "-- -*- Mode: Ada -*-" - "\n" ada-fill-comment-prefix "Filename : " (buffer-name) - "\n" ada-fill-comment-prefix "Description : " str - "\n" ada-fill-comment-prefix "Author : " (user-full-name) - "\n" ada-fill-comment-prefix "Created On : " (current-time-string) - "\n" ada-fill-comment-prefix "Last Modified By: ." - "\n" ada-fill-comment-prefix "Last Modified On: ." - "\n" ada-fill-comment-prefix "Update Count : 0" - "\n" ada-fill-comment-prefix "Status : Unknown, Use with caution!" - "\n") - - -(define-skeleton ada-display-comment - "Inserts three comment lines, making a display comment." - () - "--\n" ada-fill-comment-prefix _ "\n--") - - -(define-skeleton ada-if - "Insert skeleton if statement, prompting for a boolean-expression." - "[condition]: " - "if " str " then" \n - > _ \n - < "end if;") - - -(define-skeleton ada-elsif - "Add an elsif clause to an if statement, -prompting for the boolean-expression." - "[condition]: " - < "elsif " str " then" \n - >) - - -(define-skeleton ada-else - "Add an else clause inside an if-then-end-if clause." - () - < "else" \n - >) - - -(define-skeleton ada-loop - "Insert a skeleton loop statement. The exit statement is added by hand." - "[loop name]: " - < str & ?: & \n - > "loop" \n - > _ \n - < "end loop " str | -1 ?\;) - - -(define-skeleton ada-for-loop-prompt-variable - "Prompt for the loop variable." - "[loop variable]: " - str) - - -(define-skeleton ada-for-loop-prompt-range - "Prompt for the loop range." - "[loop range]: " - str) - - -(define-skeleton ada-for-loop - "Build a skeleton for-loop statement, prompting for the loop parameters." - "[loop name]: " - < str & ?: & \n - > "for " - (ada-for-loop-prompt-variable) - " in " - (ada-for-loop-prompt-range) - " loop" \n - > _ \n - < "end loop " str | -1 ?\;) - - -(define-skeleton ada-while-loop-prompt-entry-condition - "Prompt for the loop entry condition." - "[entry condition]: " - str) - - -(define-skeleton ada-while-loop - "Insert a skeleton while loop statement." - "[loop name]: " - < str & ?: & \n - > "while " - (ada-while-loop-prompt-entry-condition) - " loop" \n - > _ \n - < "end loop " str | -1 ?\;) - - -(define-skeleton ada-package-spec - "Insert a skeleton package specification." - "[package name]: " - "package " str " is" \n - > _ \n - < "end " str ?\;) - - -(define-skeleton ada-package-body - "Insert a skeleton package body -- includes a begin statement." - "[package name]: " - "package body " str " is" \n - > _ \n -; < "begin" \n - < "end " str ?\;) - - -(define-skeleton ada-private - "Undent and start a private section of a package spec. Reindent." - () - < "private" \n - >) - - -(define-skeleton ada-function-spec-prompt-return - "Prompts for function result type." - "[result type]: " - str) - - -(define-skeleton ada-function-spec - "Insert a function specification. Prompts for name and arguments." - "[function name]: " - "function " str - " (" ("[parameter_specification]: " str "; " ) -2 ")" - " return " - (ada-function-spec-prompt-return) - ";" \n ) - - -(define-skeleton ada-procedure-spec - "Insert a procedure specification, prompting for its name and arguments." - "[procedure name]: " - "procedure " str - " (" ("[parameter_specification]: " str "; " ) -2 ")" - ";" \n ) - - -(define-skeleton ada-subprogram-body - "Insert frame for subprogram body. -Invoke right after `ada-function-spec' or `ada-procedure-spec'." - () - ;; Remove `;' from subprogram decl - (save-excursion - (let ((pos (1+ (point)))) - (ada-search-ignore-string-comment ada-subprog-start-re t nil) - (when (ada-search-ignore-string-comment "(" nil pos t 'search-forward) - (backward-char 1) - (forward-sexp 1))) - (if (looking-at ";") - (delete-char 1))) - " is" \n - _ \n - < "begin" \n - \n - < "exception" \n - "when others => null;" \n - < < "end " - (ada-func-or-proc-name) - ";" \n) - - -(define-skeleton ada-separate - "Finish a body stub with `separate'." - () - > "separate;" \n - <) - - -;(define-skeleton ada-with -; "Inserts a with clause, prompting for the list of units depended upon." -; "[list of units depended upon]: " -; "with " str ?\;) - -;(define-skeleton ada-use -; "Inserts a use clause, prompting for the list of packages used." -; "[list of packages used]: " -; "use " str ?\;) - - -(define-skeleton ada-record - "Insert a skeleton record type declaration." - () - "record" \n - > _ \n - < "end record;") - - -(define-skeleton ada-subtype - "Start insertion of a subtype declaration, prompting for the subtype name." - "[subtype name]: " - "subtype " str " is " _ ?\; - (not (message "insert subtype indication."))) - - -(define-skeleton ada-type - "Start insertion of a type declaration, prompting for the type name." - "[type name]: " - "type " str ?\( - ("[discriminant specs]: " str " ") - | (backward-delete-char 1) | ?\) - " is " - (not (message "insert type definition."))) - - -(define-skeleton ada-task-body - "Insert a task body, prompting for the task name." - "[task name]: " - "task body " str " is\n" - "begin\n" - > _ \n - < "end " str ";" ) - - -(define-skeleton ada-task-spec - "Insert a task specification, prompting for the task name." - "[task name]: " - "task " str - " (" ("[discriminant]: " str "; ") ") is\n" - > "entry " _ \n - <"end " str ";" ) - - -(define-skeleton ada-get-param1 - "Prompt for arguments and if any enclose them in brackets." - () - ("[parameter_specification]: " str "; " ) & -2 & ")") - - -(define-skeleton ada-get-param - "Prompt for arguments and if any enclose them in brackets." - () - " (" - (ada-get-param1) | -2) - - -(define-skeleton ada-entry - "Insert a task entry, prompting for the entry name." - "[entry name]: " - "entry " str - (ada-get-param) - ";" \n) - - -(define-skeleton ada-entry-family-prompt-discriminant - "Insert an entry specification, prompting for the entry name." - "[discriminant name]: " - str) - - -(define-skeleton ada-entry-family - "Insert an entry specification, prompting for the entry name." - "[entry name]: " - "entry " str - " (" (ada-entry-family-prompt-discriminant) ")" - (ada-get-param) - ";" \n) - - -(define-skeleton ada-select - "Insert a select block." - () - "select\n" - > _ \n - < "end select;") - - -(define-skeleton ada-accept-1 - "Insert a condition statement, prompting for the condition name." - "[condition]: " - "when " str | -5 ) - - -(define-skeleton ada-accept-2 - "Insert an accept statement, prompting for the name and arguments." - "[accept name]: " - > "accept " str - (ada-get-param) - " do" \n - > _ \n - < "end " str ";" ) - - -(define-skeleton ada-accept - "Insert an accept statement (prompt for condition, name and arguments)." - () - > (ada-accept-1) & " =>\n" - (ada-accept-2)) - - -(define-skeleton ada-or-accept - "Insert an accept alternative, prompting for the condition name." - () - < "or\n" - (ada-accept)) - - -(define-skeleton ada-or-delay - "Insert a delay alternative, prompting for the delay value." - "[delay value]: " - < "or\n" - > "delay " str ";") - - -(define-skeleton ada-or-terminate - "Insert a terminate alternative." - () - < "or\n" - > "terminate;") - - -(provide 'ada-stmt) - -;;; ada-stmt.el ends here diff --git a/old_ada/ada-xref.el b/old_ada/ada-xref.el deleted file mode 100644 index c9c923e..0000000 --- a/old_ada/ada-xref.el +++ /dev/null @@ -1,2359 +0,0 @@ -;; ada-xref.el --- for lookup and completion in Ada mode - -;; Copyright (C) 1994-2019 Free Software Foundation, Inc. - -;; Author: Markus Heritsch -;; Rolf Ebert -;; Emmanuel Briot -;; Maintainer: Stephen Leake -;; Keywords: languages ada xref -;; Package: ada-mode - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This Package provides a set of functions to use the output of the -;; cross reference capabilities of the GNAT Ada compiler -;; for lookup and completion in Ada mode. -;; -;; If a file *.`adp' exists in the ada-file directory, then it is -;; read for configuration information. It is read only the first -;; time a cross-reference is asked for, and is not read later. - -;;; Code: - -;; ----- Requirements ----------------------------------------------------- - -(require 'compile) -(require 'comint) -(require 'find-file) -(require 'ada-mode) -(eval-when-compile (require 'cl-lib)) - -;; ------ User variables -(defcustom ada-xref-other-buffer t - "If nil, always display the cross-references in the same buffer. -Otherwise create either a new buffer or a new frame." - :type 'boolean :group 'ada) - -(defcustom ada-xref-create-ali nil - "If non-nil, run gcc whenever the cross-references are not up-to-date. -If nil, the cross-reference mode never runs gcc." - :type 'boolean :group 'ada) - -(defcustom ada-xref-confirm-compile nil - "If non-nil, ask for confirmation before compiling or running the application." - :type 'boolean :group 'ada) - -(defcustom ada-krunch-args "0" - "Maximum number of characters for filenames created by `gnatkr'. -Set to 0, if you don't use crunched filenames. This should be a string." - :type 'string :group 'ada) - -(defcustom ada-gnat-cmd "gnat" - "Default GNAT project file parser. -Will be run with args \"list -v -Pfile.gpr\". -Default is standard GNAT distribution; alternate \"gnatpath\" -is faster, available from Ada mode web site." - :type 'string :group 'ada) - -(defcustom ada-gnatls-args '("-v") - "Arguments to pass to `gnatls' to find location of the runtime. -Typical use is to pass `--RTS=soft-floats' on some systems that support it. - -You can also add `-I-' if you do not want the current directory to be included. -Otherwise, going from specs to bodies and back will first look for files in the -current directory. This only has an impact if you are not using project files, -but only ADA_INCLUDE_PATH." - :type '(repeat string) :group 'ada) - -(defcustom ada-prj-default-comp-opt "-gnatq -gnatQ" - "Default compilation options." - :type 'string :group 'ada) - -(defcustom ada-prj-default-bind-opt "" - "Default binder options." - :type 'string :group 'ada) - -(defcustom ada-prj-default-link-opt "" - "Default linker options." - :type 'string :group 'ada) - -(defcustom ada-prj-default-gnatmake-opt "-g" - "Default options for `gnatmake'." - :type 'string :group 'ada) - -(defcustom ada-prj-default-gpr-file "" - "Default GNAT project file. -If non-empty, this file is parsed to set the source and object directories for -the Ada mode project." - :type 'string :group 'ada) - -(defcustom ada-prj-ada-project-path-sep - (cond ((boundp 'path-separator) path-separator) ; 20.3+ - ((memq system-type '(windows-nt ms-dos)) ";") - (t ":")) - "Default separator for ada_project_path project variable." - :type 'string :group 'ada) - -(defcustom ada-prj-gnatfind-switches "-rf" - "Default switches to use for `gnatfind'. -You should modify this variable, for instance to add `-a', if you are working -in an environment where most ALI files are write-protected. -The command `gnatfind' is used every time you choose the menu -\"Show all references\"." - :type 'string :group 'ada) - -(defcustom ada-prj-default-check-cmd - (concat "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current}" - " -cargs ${comp_opt}") - "Default command to be used to compile a single file. -Emacs will substitute the current filename for ${full_current}, or add -the filename at the end. This is the same syntax as in the project file." - :type 'string :group 'ada) - -(defcustom ada-prj-default-comp-cmd - (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs" - " ${comp_opt}") - "Default command to be used to compile a single file. -Emacs will substitute the current filename for ${full_current}, or add -the filename at the end. This is the same syntax as in the project file." - :type 'string :group 'ada) - -(defcustom ada-prj-default-debugger "${cross_prefix}gdb" - "Default name of the debugger." - :type 'string :group 'ada) - -(defcustom ada-prj-default-make-cmd - (concat "${cross_prefix}gnatmake -o ${main} ${main} ${gnatmake_opt} " - "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}") - "Default command to be used to compile the application. -This is the same syntax as in the project file." - :type 'string :group 'ada) - -(defcustom ada-prj-default-project-file "" - "Name of the current project file. -Emacs will not try to use the search algorithm to find the project file if -this string is not empty. It is set whenever a project file is found." - :type '(file :must-match t) :group 'ada) - -(defcustom ada-gnatstub-opts "-q -I${src_dir}" - "Options to pass to `gnatsub' to generate the body of a package. -This has the same syntax as in the project file (with variable substitution)." - :type 'string :group 'ada) - -(defcustom ada-always-ask-project nil - "If nil, use default values when no project file was found. -Otherwise, ask the user for the name of the project file to use." - :type 'boolean :group 'ada) - -(defconst ada-on-ms-windows (memq system-type '(windows-nt)) - "True if we are running on Windows.") - -(defcustom ada-tight-gvd-integration nil - "If non-nil, a new Emacs frame will be swallowed in GVD when debugging. -If GVD is not the debugger used, nothing happens." - :type 'boolean :group 'ada) - -(defcustom ada-xref-search-with-egrep t - "If non-nil, use grep -E to find the possible declarations for an entity. -This alternate method is used when the exact location was not found in the -information provided by GNAT. However, it might be expensive if you have a lot -of sources, since it will search in all the files in your project." - :type 'boolean :group 'ada) - -(defvar ada-load-project-hook nil - "Hook that is run when loading a project file. -Each function in this hook takes one argument FILENAME, that is the name of -the project file to load. -This hook should be used to support new formats for the project files. - -If the function can load the file with the given filename, it should create a -buffer that contains a conversion of the file to the standard format of the -project files, and return that buffer. (The usual \"src_dir=\" or \"obj_dir=\" -lines.) It should return nil if it doesn't know how to convert that project -file.") - - -;; ------- Nothing to be modified by the user below this -(defvar ada-last-prj-file "" - "Name of the last project file entered by the user.") - -(defconst ada-prj-file-extension ".adp" - "The extension used for project files.") - -(defvar ada-xref-runtime-library-specs-path '() - "Directories where the specs for the standard library is found. -This is used for cross-references.") - -(defvar ada-xref-runtime-library-ali-path '() - "Directories where the ali for the standard library is found. -This is used for cross-references.") - -(defvar ada-xref-pos-ring '() - "List of positions selected by the cross-references functions. -Used to go back to these positions.") - -(defvar ada-cd-command - (if (string-match "cmdproxy.exe" shell-file-name) - "cd /d" - "cd") - "Command to use to change to a specific directory. -On Windows systems using `cmdproxy.exe' as the shell, -we need to use `/d' or the drive is never changed.") - -(defvar ada-command-separator (if ada-on-ms-windows " && " "\n") - "Separator to use between multiple commands to `compile' or `start-process'. -`cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use -\"&&\" for now.") - -(defconst ada-xref-pos-ring-max 16 - "Number of positions kept in the list `ada-xref-pos-ring'.") - -(defvar ada-operator-re - "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>" - "Regexp to match for operators.") - -(defvar ada-xref-project-files '() - "Associative list of project files with properties. -It has the format: (project project ...) -A project has the format: (project-file . project-plist) -\(See `apropos plist' for operations on property lists). -See `ada-default-prj-properties' for the list of valid properties. -The current project is retrieved with `ada-xref-current-project'. -Properties are retrieved with `ada-xref-get-project-field', set with -`ada-xref-set-project-field'. If project properties are accessed with no -project file, a (nil . default-properties) entry is created.") - - -;; ----- Identlist manipulation ------------------------------------------- -;; An identlist is a vector that is used internally to reference an identifier -;; To facilitate its use, we provide the following macros - -(defmacro ada-make-identlist () (make-vector 8 nil)) -(defmacro ada-name-of (identlist) (list 'aref identlist 0)) -(defmacro ada-line-of (identlist) (list 'aref identlist 1)) -(defmacro ada-column-of (identlist) (list 'aref identlist 2)) -(defmacro ada-file-of (identlist) (list 'aref identlist 3)) -(defmacro ada-ali-index-of (identlist) (list 'aref identlist 4)) -(defmacro ada-declare-file-of (identlist) (list 'aref identlist 5)) -(defmacro ada-references-of (identlist) (list 'aref identlist 6)) -(defmacro ada-on-declaration (identlist) (list 'aref identlist 7)) - -(defmacro ada-set-name (identlist name) (list 'aset identlist 0 name)) -(defmacro ada-set-line (identlist line) (list 'aset identlist 1 line)) -(defmacro ada-set-column (identlist col) (list 'aset identlist 2 col)) -(defmacro ada-set-file (identlist file) (list 'aset identlist 3 file)) -(defmacro ada-set-ali-index (identlist index) (list 'aset identlist 4 index)) -(defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file)) -(defmacro ada-set-references (identlist ref) (list 'aset identlist 6 ref)) -(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value)) - -(defsubst ada-get-ali-buffer (file) - "Read the ali file FILE into a new buffer, and return the buffer's name." - (find-file-noselect (ada-get-ali-file-name file))) - - -;; ----------------------------------------------------------------------- - -(defun ada-quote-cmd (cmd) - "Duplicate all `\\' characters in CMD so that it can be passed to `compile'." - (mapconcat 'identity (split-string cmd "\\\\") "\\\\")) - -(defun ada-find-executable (exec-name) - "Find the full path to the executable file EXEC-NAME. -If not found, throw an error. -On Windows systems, this will properly handle .exe extension as well." - (let ((result (or (ada-find-file-in-dir exec-name exec-path) - (ada-find-file-in-dir (concat exec-name ".exe") exec-path)))) - (if result - result - (error "`%s' not found in path" exec-name)))) - -(defun ada-initialize-runtime-library (cross-prefix) - "Initialize the variables for the runtime library location. -CROSS-PREFIX is the prefix to use for the `gnatls' command." - (let ((gnatls - (condition-case nil - ;; if gnatls not found, just give up (may not be using GNAT) - (ada-find-executable (concat cross-prefix "gnatls")) - (error nil)))) - (if gnatls - (save-excursion - (setq ada-xref-runtime-library-specs-path '() - ada-xref-runtime-library-ali-path '()) - (set-buffer (get-buffer-create "*gnatls*")) - (widen) - (erase-buffer) - ;; Even if we get an error, delete the *gnatls* buffer - (unwind-protect - (let ((status (apply 'call-process gnatls (append '(nil t nil) ada-gnatls-args)))) - (goto-char (point-min)) - - ;; Since we didn't provide all the inputs gnatls expects, it returns status 4 - (if (/= 4 status) - (error (buffer-substring (point) (line-end-position)))) - - ;; Source path - - (search-forward "Source Search Path:") - (forward-line 1) - (while (not (looking-at "^$")) - (back-to-indentation) - (add-to-list 'ada-xref-runtime-library-specs-path - (if (looking-at "") - "." - (buffer-substring-no-properties - (point) - (point-at-eol)))) - (forward-line 1)) - - ;; Object path - - (search-forward "Object Search Path:") - (forward-line 1) - (while (not (looking-at "^$")) - (back-to-indentation) - (add-to-list 'ada-xref-runtime-library-ali-path - (if (looking-at "") - "." - (buffer-substring-no-properties - (point) - (point-at-eol)))) - (forward-line 1)) - ) - (kill-buffer nil)))) - - (setq ada-xref-runtime-library-specs-path - (reverse ada-xref-runtime-library-specs-path)) - (setq ada-xref-runtime-library-ali-path - (reverse ada-xref-runtime-library-ali-path)) - )) - -(defun ada-gnat-parse-gpr (plist gpr-file) - "Set gpr_file, src_dir and obj_dir properties in PLIST by parsing GPR-FILE. -Return new value of PLIST. -GPR_FILE must be full path to file, normalized. -src_dir, obj_dir will include compiler runtime. -Assumes environment variable ADA_PROJECT_PATH is set properly." - (with-current-buffer (get-buffer-create "*gnatls*") - (erase-buffer) - - ;; this can take a long time; let the user know what's up - (message "Parsing %s ..." gpr-file) - - ;; Even if we get an error, delete the *gnatls* buffer - (unwind-protect - (let* ((cross-prefix (plist-get plist 'cross_prefix)) - (gnat (concat cross-prefix ada-gnat-cmd)) - ;; Putting quotes around gpr-file confuses gnatpath on Lynx; not clear why - (gpr-opt (concat "-P" gpr-file)) - (src-dir '()) - (obj-dir '()) - (status (call-process gnat nil t nil "list" "-v" gpr-opt))) - (goto-char (point-min)) - - (if (/= 0 status) - (error (buffer-substring (point) (line-end-position)))) - - ;; Source path - - (search-forward "Source Search Path:") - (forward-line 1) ; first directory in list - (while (not (looking-at "^$")) ; terminate on blank line - (back-to-indentation) ; skip whitespace - (cl-pushnew (if (looking-at "") - default-directory - (expand-file-name - (buffer-substring-no-properties - (point) (line-end-position)))) - src-dir :test #'equal) - (forward-line 1)) - - ;; Object path - - (search-forward "Object Search Path:") - (forward-line 1) - (while (not (looking-at "^$")) - (back-to-indentation) - (cl-pushnew (if (looking-at "") - default-directory - (expand-file-name - (buffer-substring-no-properties - (point) (line-end-position)))) - obj-dir :test #'equal) - (forward-line 1)) - - ;; Set properties - (setq plist (plist-put plist 'gpr_file gpr-file)) - (setq plist (plist-put plist 'src_dir src-dir)) - (plist-put plist 'obj_dir obj-dir) - ) - (kill-buffer nil) - (message "Parsing %s ... done" gpr-file) - ) - )) - -(defun ada-treat-cmd-string (cmd-string) - "Replace variable references ${var} in CMD-STRING with the appropriate value. -Also replace standard environment variables $var. -Assumes project exists. -As a special case, ${current} is replaced with the name of the current -file, minus extension but with directory, and ${full_current} is -replaced by the name including the extension." - - (while (string-match "\\(-[^-$IO]*[IO]\\)?\\${\\([^}]+\\)}" cmd-string) - (let (value - (name (match-string 2 cmd-string))) - (cond - ((string= name "current") - (setq value (file-name-sans-extension (buffer-file-name)))) - ((string= name "full_current") - (setq value (buffer-file-name))) - (t - (save-match-data - (setq value (ada-xref-get-project-field (intern name)))))) - - ;; Check if there is an environment variable with the same name - (if (null value) - (if (not (setq value (getenv name))) - (message "%s" (concat "No project or environment variable " name " found")))) - - (cond - ((null value) - (setq cmd-string (replace-match "" t t cmd-string))) - ((stringp value) - (setq cmd-string (replace-match value t t cmd-string))) - ((listp value) - (let ((prefix (match-string 1 cmd-string))) - (setq cmd-string (replace-match - (mapconcat (lambda(x) (concat prefix x)) value " ") - t t cmd-string))))) - )) - (substitute-in-file-name cmd-string)) - - -(defun ada-xref-get-project-field (field) - "Extract the value of FIELD from the current project file. -Project variables are substituted. - -Note that for src_dir and obj_dir, you should rather use -`ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field' -which will in addition return the default paths." - - (let* ((project-plist (cdr (ada-xref-current-project))) - (value (plist-get project-plist field))) - - (cond - ((eq field 'gnatmake_opt) - (let ((gpr-file (plist-get project-plist 'gpr_file))) - (if (not (string= gpr-file "")) - (setq value (concat "-P\"" gpr-file "\" " value))))) - - ;; FIXME: check for src_dir, obj_dir here, rather than requiring user to do it - (t - nil)) - - ;; Substitute the ${...} constructs in all the strings, including - ;; inside lists - (cond - ((stringp value) - (ada-treat-cmd-string value)) - ((null value) - nil) - ((listp value) - (mapcar (lambda(x) (if x (ada-treat-cmd-string x) x)) value)) - (t - value) - ) - )) - -(defun ada-xref-get-src-dir-field () - "Return the full value for src_dir, including the default directories. -All the directories are returned as absolute directories." - - (let ((build-dir (ada-xref-get-project-field 'build_dir))) - (append - ;; Add ${build_dir} in front of the path - (list build-dir) - - (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir) - build-dir) - - ;; Add the standard runtime at the end - ada-xref-runtime-library-specs-path))) - -(defun ada-xref-get-obj-dir-field () - "Return the full value for obj_dir, including the default directories. -All the directories are returned as absolute directories." - - (let ((build-dir (ada-xref-get-project-field 'build_dir))) - (append - ;; Add ${build_dir} in front of the path - (list build-dir) - - (ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir) - build-dir) - - ;; Add the standard runtime at the end - ada-xref-runtime-library-ali-path))) - -(defun ada-xref-set-project-field (field value) - "Set FIELD to VALUE in current project. Assumes project exists." - ;; same algorithm to find project-plist as ada-xref-current-project - (let* ((file-name (ada-xref-current-project-file)) - (project-plist (cdr (assoc file-name ada-xref-project-files)))) - - (setq project-plist (plist-put project-plist field value)) - (setcdr (assoc file-name ada-xref-project-files) project-plist))) - -(defun ada-xref-update-project-menu () - "Update the menu Ada->Project, with the list of available project files." - ;; Create the standard items. - (let ((submenu - `("Project" - ["Load..." ada-set-default-project-file t] - ["New..." ada-prj-new t] - ["Edit..." ada-prj-edit t] - "---" - ;; Add the project files - ,@(mapcar - (lambda (x) - (let* ((name (or (car x) "")) - (command `(lambda () - "Select the current project file." - (interactive) - (ada-select-prj-file ,name)))) - (vector - (file-name-nondirectory name) - command - :button (cons - :toggle - (equal ada-prj-default-project-file - (car x)) - )))) - - (or ada-xref-project-files '(nil)))))) - - (easy-menu-add-item ada-mode-menu '() submenu))) - - -;;------------------------------------------------------------- -;;-- Searching a file anywhere on the source path. -;;-- -;;-- The following functions provide support for finding a file anywhere -;;-- on the source path, without providing an explicit directory. -;;-- They also provide file name completion in the minibuffer. -;;-- -;;-- Public subprograms: ada-find-file -;;-- -;;------------------------------------------------------------- - -(defun ada-do-file-completion (string predicate flag) - "Completion function when reading a file from the minibuffer. -Completion is attempted in all the directories in the source path, -as defined in the project file." - ;; FIXME: doc arguments - - ;; This function is not itself interactive, but it is called as part - ;; of the prompt of interactive functions, so we require a project - ;; file. - (ada-require-project-file) - (let (list - (dirs (ada-xref-get-src-dir-field))) - - (while dirs - (if (file-directory-p (car dirs)) - (setq list (append list (file-name-all-completions string (car dirs))))) - (setq dirs (cdr dirs))) - (cond ((equal flag 'lambda) - (assoc string list)) - (flag - list) - (t - (try-completion string - (mapcar (lambda (x) (cons x 1)) list) - predicate))))) - -;;;###autoload -(defun ada-find-file (filename) - "Open FILENAME, from anywhere in the source path. -Completion is available." - (interactive - (list (completing-read "File: " 'ada-do-file-completion))) - (let ((file (ada-find-src-file-in-dir filename))) - (if file - (find-file file) - (error "%s not found in src_dir" filename)))) - - -;; ----- Utilities ------------------------------------------------- - -(defun ada-require-project-file () - "If the current project does not exist, load or create a default one. -Should only be called from interactive functions." - (if (string= "" ada-prj-default-project-file) - (ada-reread-prj-file (ada-prj-find-prj-file t)))) - -(defun ada-xref-current-project-file () - "Return the current project file name; never nil. -Call `ada-require-project-file' first if a project must exist." - (if (not (string= "" ada-prj-default-project-file)) - ada-prj-default-project-file - (ada-prj-find-prj-file t))) - -(defun ada-xref-current-project () - "Return the current project. -Call `ada-require-project-file' first to ensure a project exists." - (let ((file-name (ada-xref-current-project-file))) - (assoc file-name ada-xref-project-files))) - -(defun ada-show-current-project () - "Display current project file name in message buffer." - (interactive) - (message (ada-xref-current-project-file))) - -(defun ada-show-current-main () - "Display current main file name in message buffer." - (interactive) - (message "ada-mode main: %s" (ada-xref-get-project-field 'main))) - -(defun ada-xref-push-pos (filename position) - "Push (FILENAME, POSITION) on the position ring for cross-references." - (setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring)) - (if (> (length ada-xref-pos-ring) ada-xref-pos-ring-max) - (setcdr (nthcdr (1- ada-xref-pos-ring-max) ada-xref-pos-ring) nil))) - -(defun ada-xref-goto-previous-reference () - "Go to the previous cross-reference we were on." - (interactive) - (if ada-xref-pos-ring - (let ((pos (car ada-xref-pos-ring))) - (setq ada-xref-pos-ring (cdr ada-xref-pos-ring)) - (find-file (car (cdr pos))) - (goto-char (car pos))))) - -(defun ada-set-default-project-file (file) - "Set FILE as the current project file." - (interactive "fProject file:") - (ada-parse-prj-file file) - (ada-select-prj-file file)) - -;; ------ Handling the project file ----------------------------- - -(defun ada-prj-find-prj-file (&optional no-user-question) - "Find the project file associated with the current buffer. -If the buffer is not in Ada mode, or not associated with a file, -return `ada-prj-default-project-file'. Otherwise, search for a file with -the same base name as the Ada file, but extension given by -`ada-prj-file-extension' (default .adp). If not found, search for *.adp -in the current directory; if several are found, and NO-USER-QUESTION -is non-nil, prompt the user to select one. If none are found, return -\"default.adp\"." - - (let (selected) - - (if (not (and (derived-mode-p 'ada-mode) - buffer-file-name)) - - ;; Not in an Ada buffer, or current buffer not associated - ;; with a file (for instance an emerge buffer) - (setq selected nil) - - ;; other cases: use a more complex algorithm - - (let* ((current-file (buffer-file-name)) - (first-choice (concat - (file-name-sans-extension current-file) - ada-prj-file-extension)) - (dir (file-name-directory current-file)) - - (prj-files (directory-files - dir t - (concat ".*" (regexp-quote - ada-prj-file-extension) "$"))) - (choice nil)) - - (cond - - ((file-exists-p first-choice) - ;; filename.adp - (setq selected first-choice)) - - ((= (length prj-files) 1) - ;; Exactly one project file was found in the current directory - (setq selected (car prj-files))) - - ((and (> (length prj-files) 1) (not no-user-question)) - ;; multiple project files in current directory, ask the user - (save-window-excursion - (with-output-to-temp-buffer "*choice list*" - (princ "There are more than one possible project file.\n") - (princ "Which one should we use ?\n\n") - (princ " no. file name \n") - (princ " --- ------------------------\n") - (let ((counter 1)) - (while (<= counter (length prj-files)) - (princ (format " %2d) %s\n" - counter - (nth (1- counter) prj-files))) - (setq counter (1+ counter)) - - ))) ; end of with-output-to ... - (setq choice nil) - (while (or - (not choice) - (not (integerp choice)) - (< choice 1) - (> choice (length prj-files))) - (setq choice (string-to-number - (read-from-minibuffer "Enter No. of your choice: ")))) - (setq selected (nth (1- choice) prj-files)))) - - ((= (length prj-files) 0) - ;; No project file in the current directory; ask user - (unless (or no-user-question (not ada-always-ask-project)) - (setq ada-last-prj-file - (read-file-name - (concat "project file [" ada-last-prj-file "]:") - nil ada-last-prj-file)) - (unless (string= ada-last-prj-file "") - (setq selected ada-last-prj-file)))) - ))) - - (or selected "default.adp") - )) - -(defun ada-default-prj-properties () - "Return the default project properties list with the current buffer as main." - - (let ((file (buffer-file-name nil))) - (list - ;; variable name alphabetical order - 'ada_project_path (or (getenv "ADA_PROJECT_PATH") "") - 'ada_project_path_sep ada-prj-ada-project-path-sep - 'bind_opt ada-prj-default-bind-opt - 'build_dir default-directory - 'casing (if (listp ada-case-exception-file) - ada-case-exception-file - (list ada-case-exception-file)) - 'check_cmd (list ada-prj-default-check-cmd) ;; FIXME: should not a list - 'comp_cmd (list ada-prj-default-comp-cmd) ;; FIXME: should not a list - 'comp_opt ada-prj-default-comp-opt - 'cross_prefix "" - 'debug_cmd (concat ada-prj-default-debugger - " ${main}" (if ada-on-ms-windows ".exe")) ;; FIXME: don't need .exe? - 'debug_post_cmd (list nil) - 'debug_pre_cmd (list (concat ada-cd-command " ${build_dir}")) - 'gnatmake_opt ada-prj-default-gnatmake-opt - 'gnatfind_opt ada-prj-gnatfind-switches - 'gpr_file ada-prj-default-gpr-file - 'link_opt ada-prj-default-link-opt - 'main (if file - (file-name-nondirectory - (file-name-sans-extension file)) - "") - 'make_cmd (list ada-prj-default-make-cmd) ;; FIXME: should not a list - 'obj_dir (list ".") - 'remote_machine "" - 'run_cmd (list (concat "./${main}" (if ada-on-ms-windows ".exe"))) - ;; FIXME: should not a list - ;; FIXME: don't need .exe? - 'src_dir (list ".") - ))) - -(defun ada-parse-prj-file (prj-file) - "Read PRJ-FILE, set project properties in `ada-xref-project-files'." - (let ((project (ada-default-prj-properties))) - - (setq prj-file (expand-file-name prj-file)) - (if (string= (file-name-extension prj-file) "gpr") - (setq project (ada-gnat-parse-gpr project prj-file)) - - (setq project (ada-parse-prj-file-1 prj-file project)) - ) - - ;; Store the project properties - (if (assoc prj-file ada-xref-project-files) - (setcdr (assoc prj-file ada-xref-project-files) project) - (add-to-list 'ada-xref-project-files (cons prj-file project))) - - (ada-xref-update-project-menu) - )) - -(defun ada-parse-prj-file-1 (prj-file project) - "Parse the Ada mode project file PRJ-FILE, set project properties in PROJECT. -Return new value of PROJECT." - (let ((ada-buffer (current-buffer)) - ;; fields that are lists or otherwise require special processing - ada_project_path casing comp_cmd check_cmd - debug_pre_cmd debug_post_cmd gpr_file make_cmd obj_dir src_dir run_cmd) - - ;; Give users a chance to use compiler-specific project file formats - (let ((buffer (run-hook-with-args-until-success - 'ada-load-project-hook prj-file))) - (unless buffer - ;; we load the project file with no warnings; if it does not - ;; exist, we stay in the Ada buffer; no project variable - ;; settings will be found. That works for the default - ;; "default.adp", which does not exist as a file. - (setq buffer (find-file-noselect prj-file nil))) - (set-buffer buffer)) - - (widen) - (goto-char (point-min)) - - ;; process each line - (while (not (eobp)) - - ;; ignore lines that don't have the format "name=value", put - ;; 'name', 'value' in match-string. - (if (looking-at "^\\([^=\n]+\\)=\\(.*\\)") - (cond - ;; FIXME: strip trailing spaces - ;; variable name alphabetical order - ((string= (match-string 1) "ada_project_path") - (cl-pushnew (expand-file-name - (substitute-in-file-name (match-string 2))) - ada_project_path :test #'equal)) - - ((string= (match-string 1) "build_dir") - (setq project - (plist-put project 'build_dir - (file-name-as-directory (match-string 2))))) - - ((string= (match-string 1) "casing") - (cl-pushnew (expand-file-name (substitute-in-file-name (match-string 2))) - casing :test #'equal)) - - ((string= (match-string 1) "check_cmd") - (cl-pushnew (match-string 2) check_cmd :test #'equal)) - - ((string= (match-string 1) "comp_cmd") - (cl-pushnew (match-string 2) comp_cmd :test #'equal)) - - ((string= (match-string 1) "debug_post_cmd") - (cl-pushnew (match-string 2) debug_post_cmd :test #'equal)) - - ((string= (match-string 1) "debug_pre_cmd") - (cl-pushnew (match-string 2) debug_pre_cmd :test #'equal)) - - ((string= (match-string 1) "gpr_file") - ;; expand now; path is relative to Emacs project file - (setq gpr_file (expand-file-name (match-string 2)))) - - ((string= (match-string 1) "make_cmd") - (cl-pushnew (match-string 2) make_cmd :test #'equal)) - - ((string= (match-string 1) "obj_dir") - (cl-pushnew (file-name-as-directory - (expand-file-name (match-string 2))) - obj_dir :test #'equal)) - - ((string= (match-string 1) "run_cmd") - (cl-pushnew (match-string 2) run_cmd :test #'equal)) - - ((string= (match-string 1) "src_dir") - (cl-pushnew (file-name-as-directory - (expand-file-name (match-string 2))) - src_dir :test #'equal)) - - (t - ;; any other field in the file is just copied - (setq project (plist-put project - (intern (match-string 1)) - (match-string 2)))))) - - (forward-line 1)) - - ;; done reading file - - ;; back to the user buffer - (set-buffer ada-buffer) - - ;; process accumulated lists - (if ada_project_path - (let ((sep (plist-get project 'ada_project_path_sep))) - (setq ada_project_path (reverse ada_project_path)) - (setq ada_project_path (mapconcat 'identity ada_project_path sep)) - (setq project (plist-put project 'ada_project_path ada_project_path)) - ;; env var needed now for ada-gnat-parse-gpr - (setenv "ADA_PROJECT_PATH" ada_project_path))) - - (if debug_post_cmd (setq project (plist-put project 'debug_post_cmd (reverse debug_post_cmd)))) - (if debug_pre_cmd (setq project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd)))) - (if casing (setq project (plist-put project 'casing (reverse casing)))) - (if check_cmd (setq project (plist-put project 'check_cmd (reverse check_cmd)))) - (if comp_cmd (setq project (plist-put project 'comp_cmd (reverse comp_cmd)))) - (if make_cmd (setq project (plist-put project 'make_cmd (reverse make_cmd)))) - (if run_cmd (setq project (plist-put project 'run_cmd (reverse run_cmd)))) - - (if gpr_file - (progn - (setq project (ada-gnat-parse-gpr project gpr_file)) - ;; append Ada source and object directories to others from Emacs project file - (setq src_dir (append (plist-get project 'src_dir) src_dir)) - (setq obj_dir (append (plist-get project 'obj_dir) obj_dir)) - (setq ada-xref-runtime-library-specs-path '() - ada-xref-runtime-library-ali-path '())) - ) - - ;; FIXME: gnatpath.exe doesn't output the runtime libraries, so always call ada-initialize-runtime-library - ;; if using a gpr_file, the runtime library directories are - ;; included in src_dir and obj_dir; otherwise they are in the - ;; 'runtime-library' variables. - ;; FIXME: always append to src_dir, obj_dir - (ada-initialize-runtime-library (or (ada-xref-get-project-field 'cross_prefix) "")) - ;;) - - (if obj_dir (setq project (plist-put project 'obj_dir (reverse obj_dir)))) - (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir)))) - - project - )) - -(defun ada-select-prj-file (file) - "Select FILE as the current project file." - (interactive) - (setq ada-prj-default-project-file (expand-file-name file)) - - (let ((casing (ada-xref-get-project-field 'casing))) - (if casing - (progn - ;; FIXME: use ada-get-absolute-dir here - (setq ada-case-exception-file casing) - (ada-case-read-exceptions)))) - - (let ((ada_project_path (ada-xref-get-project-field 'ada_project_path))) - (if ada_project_path - ;; FIXME: use ada-get-absolute-dir, mapconcat here - (setenv "ADA_PROJECT_PATH" ada_project_path))) - - (setq compilation-search-path (ada-xref-get-src-dir-field)) - - (setq ada-search-directories-internal - ;; FIXME: why do we need directory-file-name here? - (append (mapcar 'directory-file-name compilation-search-path) - ada-search-directories)) - - ;; return t, for decent display in message buffer when called interactively - t) - -(defun ada-find-references (&optional pos arg local-only) - "Find all references to the entity under POS. -Calls gnatfind to find the references. -If ARG is non-nil, the contents of the old *gnatfind* buffer is preserved. -If LOCAL-ONLY is non-nil, only declarations in the current file are returned." - (interactive "d\nP") - (ada-require-project-file) - - (let* ((identlist (ada-read-identifier pos)) - (alifile (ada-get-ali-file-name (ada-file-of identlist))) - (process-environment (ada-set-environment))) - - (set-buffer (get-file-buffer (ada-file-of identlist))) - - ;; if the file is more recent than the executable - (if (or (buffer-modified-p (current-buffer)) - (file-newer-than-file-p (ada-file-of identlist) alifile)) - (ada-find-any-references (ada-name-of identlist) - (ada-file-of identlist) - nil nil local-only arg) - (ada-find-any-references (ada-name-of identlist) - (ada-file-of identlist) - (ada-line-of identlist) - (ada-column-of identlist) local-only arg))) - ) - -(defun ada-find-local-references (&optional pos arg) - "Find all references to the entity under POS. -Calls `gnatfind' to find the references. -If ARG is non-nil, the contents of the old *gnatfind* buffer is preserved." - (interactive "d\nP") - (ada-find-references pos arg t)) - -(defconst ada-gnatfind-buffer-name "*gnatfind*") - -(defun ada-find-any-references - (entity &optional file line column local-only append) - "Search for references to any entity whose name is ENTITY. -ENTITY was first found the location given by FILE, LINE and COLUMN. -If LOCAL-ONLY is non-nil, then list only the references in FILE, -which is much faster. -If APPEND is non-nil, then append the output of the command to the -existing buffer `*gnatfind*', if there is one." - (interactive "sEntity name: ") - (ada-require-project-file) - - ;; Prepare the gnatfind command. Note that we must protect the quotes - ;; around operators, so that they are correctly handled and can be - ;; processed (gnatfind \"+\":...). - (let* ((quote-entity - (if (= (aref entity 0) ?\") - (if ada-on-ms-windows - (concat "\\\"" (substring entity 1 -1) "\\\"") - (concat "'\"" (substring entity 1 -1) "\"'")) - entity)) - (switches (ada-xref-get-project-field 'gnatfind_opt)) - ;; FIXME: use gpr_file - (cross-prefix (ada-xref-get-project-field 'cross_prefix)) - (command (concat cross-prefix "gnat find " switches " " - quote-entity - (if file (concat ":" (file-name-nondirectory file))) - (if line (concat ":" line)) - (if column (concat ":" column)) - (if local-only (concat " " (file-name-nondirectory file))) - )) - old-contents) - - ;; If a project file is defined, use it - (if (and ada-prj-default-project-file - (not (string= ada-prj-default-project-file ""))) - (if (string-equal (file-name-extension ada-prj-default-project-file) - "gpr") - (setq command (concat command " -P\"" ada-prj-default-project-file "\"")) - (setq command (concat command " -p\"" ada-prj-default-project-file "\"")))) - - (if (and append (get-buffer ada-gnatfind-buffer-name)) - (with-current-buffer "*gnatfind*" - (setq old-contents (buffer-string)))) - - (let ((compilation-error "reference")) - (compilation-start command 'compilation-mode (lambda (_mode) ada-gnatfind-buffer-name))) - - ;; Hide the "Compilation" menu - (with-current-buffer ada-gnatfind-buffer-name - (local-unset-key [menu-bar compilation-menu]) - - (if old-contents - (progn - (goto-char 1) - (setq buffer-read-only nil) - (insert old-contents) - (setq buffer-read-only t) - (goto-char (point-max))))) - ) - ) - -(defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file)) - -;; ----- Identifier Completion -------------------------------------------- -(defun ada-complete-identifier (pos) - "Try to complete the identifier around POS, using compiler cross-reference information." - (interactive "d") - (ada-require-project-file) - - ;; Initialize function-local variables and jump to the .ali buffer - ;; Note that for regexp search is case insensitive too - (let* ((curbuf (current-buffer)) - (identlist (ada-read-identifier pos)) - (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\(" - (regexp-quote (ada-name-of identlist)) - "[a-zA-Z0-9_]*\\)")) - (completed nil) - (symalist nil)) - - ;; Open the .ali file - (set-buffer (ada-get-ali-buffer (buffer-file-name))) - (goto-char (point-max)) - - ;; build an alist of possible completions - (while (re-search-backward sofar nil t) - (setq symalist (cons (cons (match-string 1) nil) symalist))) - - (setq completed (try-completion "" symalist)) - - ;; kills .ali buffer - (kill-buffer nil) - - ;; deletes the incomplete identifier in the buffer - (set-buffer curbuf) - (looking-at "[a-zA-Z0-9_]+") - (replace-match "") - ;; inserts the completed symbol - (insert completed) - )) - -;; ----- Cross-referencing ---------------------------------------- - -(defun ada-point-and-xref () - "Jump to the declaration of the entity below the cursor." - (interactive) - (mouse-set-point last-input-event) - (ada-goto-declaration (point))) - -(defun ada-point-and-xref-body () - "Jump to the body of the entity under the cursor." - (interactive) - (mouse-set-point last-input-event) - (ada-goto-body (point))) - -(defun ada-goto-body (pos &optional other-frame) - "Display the body of the entity around POS. -OTHER-FRAME non-nil means display in another frame. -If the entity doesn't have a body, display its declaration. -As a side effect, the buffer for the declaration is also open." - (interactive "d") - (ada-goto-declaration pos other-frame) - - ;; Temporarily force the display in the same buffer, since we - ;; already changed previously - (let ((ada-xref-other-buffer nil)) - (ada-goto-declaration (point) nil))) - -(defun ada-goto-declaration (pos &optional other-frame) - "Display the declaration of the identifier around POS. -The declaration is shown in another buffer if `ada-xref-other-buffer' is -non-nil. -If OTHER-FRAME is non-nil, display the cross-reference in another frame." - (interactive "d") - (ada-require-project-file) - (push-mark pos) - (ada-xref-push-pos (buffer-file-name) pos) - - ;; First try the standard algorithm by looking into the .ali file, but if - ;; that file was too old or even did not exist, try to look in the whole - ;; object path for a possible location. - (let ((identlist (ada-read-identifier pos))) - (condition-case err - (ada-find-in-ali identlist other-frame) - ;; File not found: print explicit error message - (ada-error-file-not-found - (message "%s%s" (error-message-string err) (nthcdr 1 err))) - - (error - (let ((ali-file (ada-get-ali-file-name (ada-file-of identlist)))) - - ;; If the ALI file was up-to-date, then we probably have a predefined - ;; entity, whose references are not given by GNAT - (if (and (file-exists-p ali-file) - (file-newer-than-file-p ali-file (ada-file-of identlist))) - (message "No cross-reference found -- may be a predefined entity.") - - ;; Else, look in every ALI file, except if the user doesn't want that - (if ada-xref-search-with-egrep - (ada-find-in-src-path identlist other-frame) - (message "Cross-referencing information is not up-to-date; please recompile.") - ))))))) - -(defun ada-goto-declaration-other-frame (pos) - "Display the declaration of the identifier around POS. -The declaration is shown in another frame if `ada-xref-other-buffer' is -non-nil." - (interactive "d") - (ada-goto-declaration pos t)) - -(defun ada-remote (command) - "Return the remote version of COMMAND, or COMMAND if remote_machine is nil." - (let ((machine (ada-xref-get-project-field 'remote_machine))) - (if (or (not machine) (string= machine "")) - command - (format "%s %s '(%s)'" - remote-shell-program - machine - command)))) - -(defun ada-get-absolute-dir-list (dir-list root-dir) - "Return the list of absolute directories found in DIR-LIST. -If a directory is a relative directory, ROOT-DIR is prepended. -Project and environment variables are substituted." - (mapcar (lambda (x) (expand-file-name x (ada-treat-cmd-string root-dir))) dir-list)) - -(defun ada-set-environment () - "Prepare an environment for Ada compilation. -This returns a new value to use for `process-environment', -but does not actually put it into use. -It modifies the source path and object path with the values found in the -project file." - (let ((include (getenv "ADA_INCLUDE_PATH")) - (objects (getenv "ADA_OBJECTS_PATH")) - (build-dir (ada-xref-get-project-field 'build_dir))) - (if include - (setq include (concat path-separator include))) - (if objects - (setq objects (concat path-separator objects))) - (cons - (concat "ADA_INCLUDE_PATH=" - (mapconcat (lambda(x) (expand-file-name x build-dir)) - (ada-xref-get-project-field 'src_dir) - path-separator) - include) - (cons - (concat "ADA_OBJECTS_PATH=" - (mapconcat (lambda(x) (expand-file-name x build-dir)) - (ada-xref-get-project-field 'obj_dir) - path-separator) - objects) - process-environment)))) - -(defun ada-compile-application (&optional arg) - "Compile the application, using the command found in the project file. -If ARG is not nil, ask for user confirmation." - (interactive "P") - (ada-require-project-file) - (let ((cmd (ada-xref-get-project-field 'make_cmd)) - (process-environment (ada-set-environment)) - (compilation-scroll-output t)) - - (setq compilation-search-path (ada-xref-get-src-dir-field)) - - ;; If no project file was found, ask the user - (unless cmd - (setq cmd '("") arg t)) - - ;; Make a single command from the list of commands, including the - ;; commands to run it on a remote machine. - (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) - - (if (or ada-xref-confirm-compile arg) - (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) - - ;; Insert newlines so as to separate the name of the commands to run - ;; and the output of the commands. This doesn't work with cmdproxy.exe, - ;; which gets confused by newline characters. - (if (not (string-match ".exe" shell-file-name)) - (setq cmd (concat cmd "\n\n"))) - - (compile (ada-quote-cmd cmd)))) - -(defun ada-set-main-compile-application () - "Set main project variable to current buffer, build main." - (interactive) - (ada-require-project-file) - (let* ((file (buffer-file-name (current-buffer))) - main) - (if (not file) - (error "No file for current buffer") - - (setq main - (if file - (file-name-nondirectory - (file-name-sans-extension file)) - "")) - (ada-xref-set-project-field 'main main) - (ada-compile-application)))) - -(defun ada-compile-current (&optional arg prj-field) - "Recompile the current file. -If ARG is non-nil, ask for user confirmation of the command. -PRJ-FIELD is the name of the field to use in the project file to get the -command, and should be either `comp_cmd' (default) or `check_cmd'." - (interactive "P") - (ada-require-project-file) - (let* ((field (if prj-field prj-field 'comp_cmd)) - (cmd (ada-xref-get-project-field field)) - (process-environment (ada-set-environment)) - (compilation-scroll-output t)) - - (unless cmd - (setq cmd '("") arg t)) - - ;; Make a single command from the list of commands, including the - ;; commands to run it on a remote machine. - (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) - - ;; If no project file was found, ask the user - (if (or ada-xref-confirm-compile arg) - (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) - - (compile (ada-quote-cmd cmd)))) - -(defun ada-check-current (&optional arg) - "Check the current file for syntax errors. -If ARG is non-nil, ask for user confirmation of the command." - (interactive "P") - (ada-compile-current arg 'check_cmd)) - -(defun ada-run-application (&optional arg) - "Run the application. -If ARG is non-nil, ask for user confirmation." - (interactive) - (ada-require-project-file) - - (let ((machine (ada-xref-get-project-field 'cross_prefix))) - (if (and machine (not (string= machine ""))) - (error "This feature is not supported yet for cross environments"))) - - (let ((command (ada-xref-get-project-field 'run_cmd))) - - ;; Guess the command if it wasn't specified - (if (not command) - (setq command (list (file-name-sans-extension (buffer-name))))) - - ;; Modify the command to run remotely - (setq command (ada-remote (mapconcat 'identity command - ada-command-separator))) - - ;; Ask for the arguments to the command if required - (if (or ada-xref-confirm-compile arg) - (setq command (read-from-minibuffer "Enter command to execute: " - command))) - - ;; Run the command - (with-current-buffer (get-buffer-create "*run*") - (setq buffer-read-only nil) - - (erase-buffer) - (start-process "run" (current-buffer) shell-file-name - "-c" command) - (comint-mode) - ;; Set these two variables to their default values, since otherwise - ;; the output buffer is scrolled so that only the last output line - ;; is visible at the top of the buffer. - (set (make-local-variable 'scroll-step) 0) - (set (make-local-variable 'scroll-conservatively) 0) - ) - (display-buffer "*run*") - - ;; change to buffer *run* for interactive programs - (other-window 1) - (switch-to-buffer "*run*") - )) - -(defun ada-gdb-application (&optional arg executable-name) - "Start the debugger on the application. -If ARG is non-nil, ask the user to confirm the command. -EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the -project file." - (interactive "P") - (ada-require-project-file) - (let ((buffer (current-buffer)) - cmd pre-cmd post-cmd) - (setq cmd (if executable-name - (concat ada-prj-default-debugger " " executable-name) - (ada-xref-get-project-field 'debug_cmd)) - pre-cmd (ada-xref-get-project-field 'debug_pre_cmd) - post-cmd (ada-xref-get-project-field 'debug_post_cmd)) - - ;; If the command was not given in the project file, start a bare gdb - (if (not cmd) - (setq cmd (concat ada-prj-default-debugger - " " - (or executable-name - (file-name-sans-extension (buffer-file-name)))))) - - ;; For gvd, add an extra switch so that the Emacs window is completely - ;; swallowed inside the Gvd one - (if (and ada-tight-gvd-integration - (string-match "^[^ \t]*gvd" cmd)) - ;; Start a new frame, so that when gvd exists we do not kill Emacs - ;; We make sure that gvd swallows the new frame, not the one the - ;; user has been using until now - ;; The frame is made invisible initially, so that GtkPlug gets a - ;; chance to fully manage it. Then it works fine with Enlightenment - ;; as well - (let ((frame (make-frame '((visibility . nil))))) - (setq cmd (concat - cmd " --editor-window=" - (cdr (assoc 'outer-window-id (frame-parameters frame))))) - (select-frame frame))) - - ;; Add a -fullname switch - ;; Use the remote machine - (setq cmd (ada-remote (concat cmd " -fullname "))) - - ;; Ask for confirmation if required - (if (or arg ada-xref-confirm-compile) - (setq cmd (read-from-minibuffer "enter command to debug: " cmd))) - - (let ((old-comint-exec (symbol-function 'comint-exec))) - - ;; Do not add -fullname, since we can have a 'rsh' command in front. - ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef - (fset 'gud-gdb-massage-args (lambda (_file args) args)) - - (setq pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) - (if (not (equal pre-cmd "")) - (setq pre-cmd (concat pre-cmd ada-command-separator))) - - (setq post-cmd (mapconcat 'identity post-cmd "\n")) - (if post-cmd - (setq post-cmd (concat post-cmd "\n"))) - - - ;; Temporarily replaces the definition of `comint-exec' so that we - ;; can execute commands before running gdb. - ;; FIXME: This is evil and not temporary !!! -stef - (fset 'comint-exec - `(lambda (buffer name command startfile switches) - (let (compilation-buffer-name-function) - (save-excursion - (setq compilation-buffer-name-function - (lambda(x) (buffer-name buffer))) - (compile (ada-quote-cmd - (concat ,pre-cmd - command " " - (mapconcat 'identity switches " ")))))) - )) - - ;; Tight integration should force the tty mode - (if (and (string-match "gvd" (comint-arguments cmd 0 0)) - ada-tight-gvd-integration - (not (string-match "--tty" cmd))) - (setq cmd (concat cmd "--tty"))) - - (if (and (string-match "jdb" (comint-arguments cmd 0 0)) - (boundp 'jdb)) - (funcall (symbol-function 'jdb) cmd) - (gdb cmd)) - - ;; Restore the standard fset command (or for instance C-U M-x shell - ;; wouldn't work anymore - - (fset 'comint-exec old-comint-exec) - - ;; Send post-commands to the debugger - (process-send-string (get-buffer-process (current-buffer)) post-cmd) - - ;; Move to the end of the debugger buffer, so that it is automatically - ;; scrolled from then on. - (goto-char (point-max)) - - ;; Display both the source window and the debugger window (the former - ;; above the latter). No need to show the debugger window unless it - ;; is going to have some relevant information. - (if (or (not (string-match "gvd" (comint-arguments cmd 0 0))) - (string-match "--tty" cmd)) - (split-window-below)) - (switch-to-buffer buffer) - ))) - -(defun ada-reread-prj-file (&optional filename) - "Reread either the current project, or FILENAME if non-nil. -If FILENAME is non-nil, set it as current project." - (interactive "P") - (if (not filename) - (setq filename ada-prj-default-project-file)) - (ada-parse-prj-file filename) - (ada-select-prj-file filename)) - -;; ------ Private routines - -(defun ada-xref-current (file &optional ali-file-name) - "Update the cross-references for FILE. -This in fact recompiles FILE to create ALI-FILE-NAME. -This function returns the name of the file that was recompiled to generate -the cross-reference information. Note that the ali file can then be deduced -by replacing the file extension with `.ali'." - ;; kill old buffer - (if (and ali-file-name - (get-file-buffer ali-file-name)) - (kill-buffer (get-file-buffer ali-file-name))) - - (let* ((name (convert-standard-filename file)) - (body-name (or (ada-get-body-name name) name))) - - ;; Always recompile the body when we can. We thus temporarily switch to a - ;; buffer than contains the body of the unit - (save-excursion - (let ((body-visible (find-buffer-visiting body-name)) - process) - (if body-visible - (set-buffer body-visible) - (find-file body-name)) - - ;; Execute the compilation. Note that we must wait for the end of the - ;; process, or the ALI file would still not be available. - ;; Unfortunately, the underlying `compile' command that we use is - ;; asynchronous. - (ada-compile-current) - (setq process (get-buffer-process "*compilation*")) - - (while (and process - (not (equal (process-status process) 'exit))) - (sit-for 1)) - - ;; remove the buffer for the body if it wasn't there before - (unless body-visible - (kill-buffer (find-buffer-visiting body-name))) - )) - body-name)) - -(defun ada-find-file-in-dir (file dir-list) - "Search for FILE in DIR-LIST." - (let (found) - (while (and (not found) dir-list) - (setq found (concat (file-name-as-directory (car dir-list)) - (file-name-nondirectory file))) - - (unless (file-exists-p found) - (setq found nil)) - (setq dir-list (cdr dir-list))) - found)) - -(defun ada-find-ali-file-in-dir (file) - "Find the ali file FILE, searching obj_dir for the current project. -Adds build_dir in front of the search path to conform to gnatmake's behavior, -and the standard runtime location at the end." - (ada-find-file-in-dir file (ada-xref-get-obj-dir-field))) - -(defun ada-find-src-file-in-dir (file) - "Find the source file FILE, searching src_dir for the current project. -Adds the standard runtime location at the end of the search path to conform -to gnatmake's behavior." - (ada-find-file-in-dir file (ada-xref-get-src-dir-field))) - -(defun ada-get-ali-file-name (file) - "Create the ali file name for the Ada file FILE. -The file is searched for in every directory shown in the obj_dir lines of -the project file." - - ;; This function has to handle the special case of non-standard - ;; file names (i.e. not .adb or .ads) - ;; The trick is the following: - ;; 1- replace the extension of the current file with .ali, - ;; and look for this file - ;; 2- If this file is found: - ;; grep the "^U" lines, and make sure we are not reading the - ;; .ali file for a spec file. If we are, go to step 3. - ;; 3- If the file is not found or step 2 failed: - ;; find the name of the "other file", ie the body, and look - ;; for its associated .ali file by substituting the extension - ;; - ;; We must also handle the case of separate packages and subprograms: - ;; 4- If no ali file was found, we try to modify the file name by removing - ;; everything after the last '-' or '.' character, so as to get the - ;; ali file for the parent unit. If we found an ali file, we check that - ;; it indeed contains the definition for the separate entity by checking - ;; the 'D' lines. This is done repeatedly, in case the direct parent is - ;; also a separate. - - (with-current-buffer (get-file-buffer file) - (let ((short-ali-file-name (concat (file-name-base file) ".ali")) - ali-file-name - is-spec) - - ;; If we have a non-standard file name, and this is a spec, we first - ;; look for the .ali file of the body, since this is the one that - ;; contains the most complete information. If not found, we will do what - ;; we can with the .ali file for the spec... - - (if (not (string= (file-name-extension file) "ads")) - (let ((specs ada-spec-suffixes)) - (while specs - (if (string-match (concat (regexp-quote (car specs)) "$") - file) - (setq is-spec t)) - (setq specs (cdr specs))))) - - (if is-spec - (setq ali-file-name - (ada-find-ali-file-in-dir - (concat (file-name-base (ada-other-file-name)) ".ali")))) - - - (setq ali-file-name - (or ali-file-name - - ;; Else we take the .ali file associated with the unit - (ada-find-ali-file-in-dir short-ali-file-name) - - - ;; else we did not find the .ali file Second chance: in case - ;; the files do not have standard names (such as for instance - ;; file_s.ada and file_b.ada), try to go to the other file - ;; and look for its ali file - (ada-find-ali-file-in-dir - (concat (file-name-base (ada-other-file-name)) ".ali")) - - - ;; If we still don't have an ali file, try to get the one - ;; from the parent unit, in case we have a separate entity. - (let ((parent-name (file-name-base file))) - - (while (and (not ali-file-name) - (string-match "^\\(.*\\)[.-][^.-]*" parent-name)) - - (setq parent-name (match-string 1 parent-name)) - (setq ali-file-name (ada-find-ali-file-in-dir - (concat parent-name ".ali"))) - ) - ali-file-name))) - - ;; If still not found, try to recompile the file - (if (not ali-file-name) - ;; Recompile only if the user asked for this, and search the ali - ;; filename again. We avoid a possible infinite recursion by - ;; temporarily disabling the automatic compilation. - - (if ada-xref-create-ali - (setq ali-file-name - (concat (file-name-sans-extension (ada-xref-current file)) - ".ali")) - - (error "`.ali' file not found; recompile your source file")) - - - ;; same if the .ali file is too old and we must recompile it - (if (and (file-newer-than-file-p file ali-file-name) - ada-xref-create-ali) - (ada-xref-current file ali-file-name))) - - ;; Always return the correct absolute file name - (expand-file-name ali-file-name)) - )) - -(defun ada-get-ada-file-name (file original-file) - "Create the complete file name (+directory) for FILE. -The original file (where the user was) is ORIGINAL-FILE. -Search in project file for possible paths." - - (save-excursion - - ;; If the buffer for original-file, use it to get the values from the - ;; project file, otherwise load the file and its project file - (let ((buffer (get-file-buffer original-file))) - (if buffer - (set-buffer buffer) - (find-file original-file))) - - ;; we choose the first possible completion and we - ;; return the absolute file name - (let ((filename (ada-find-src-file-in-dir file))) - (if filename - (expand-file-name filename) - (signal 'ada-error-file-not-found (file-name-nondirectory file))) - ))) - -(defun ada-find-file-number-in-ali (file) - "Return the file number for FILE in the associated ali file." - (set-buffer (ada-get-ali-buffer file)) - (goto-char (point-min)) - - (let ((begin (re-search-forward "^D"))) - (beginning-of-line) - (re-search-forward (concat "^D " (file-name-nondirectory file))) - (count-lines begin (point)))) - -(defun ada-read-identifier (pos) - "Return the identlist around POS and switch to the .ali buffer. -The returned list represents the entity, and can be manipulated through the -macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." - - ;; If at end of buffer (e.g the buffer is empty), error - (if (>= (point) (point-max)) - (error "No identifier on point")) - - ;; goto first character of the identifier/operator (skip backward < and > - ;; since they are part of multiple character operators - (goto-char pos) - (skip-chars-backward "a-zA-Z0-9_<>") - - ;; check if it really is an identifier - (if (ada-in-comment-p) - (error "Inside comment")) - - (let (identifier identlist) - ;; Just in front of a string => we could have an operator declaration, - ;; as in "+", "-", .. - (if (= (char-after) ?\") - (forward-char 1)) - - ;; if looking at an operator - ;; This is only true if: - ;; - the symbol is +, -, ... - ;; - the symbol is made of letters, and not followed by _ or a letter - (if (and (looking-at ada-operator-re) - (or (not (= (char-syntax (char-after)) ?w)) - (not (or (= (char-syntax (char-after (match-end 0))) ?w) - (= (char-after (match-end 0)) ?_))))) - (progn - (if (and (= (char-before) ?\") - (= (char-after (+ (length (match-string 0)) (point))) ?\")) - (forward-char -1)) - (setq identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) - - (if (ada-in-string-p) - (error "Inside string or character constant")) - (if (looking-at (concat ada-keywords "[^a-zA-Z_]")) - (error "No cross-reference available for reserved keyword")) - (if (looking-at "[a-zA-Z0-9_]+") - (setq identifier (match-string 0)) - (error "No identifier around"))) - - ;; Build the identlist - (setq identlist (ada-make-identlist)) - (ada-set-name identlist (downcase identifier)) - (ada-set-line identlist - (number-to-string (count-lines 1 (point)))) - (ada-set-column identlist - (number-to-string (1+ (current-column)))) - (ada-set-file identlist (buffer-file-name)) - identlist - )) - -(defun ada-get-all-references (identlist) - "Complete IDENTLIST with definition file and places where it is referenced. -Information is extracted from the ali file." - - (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist))) - declaration-found) - (set-buffer ali-buffer) - (goto-char (point-min)) - (ada-set-on-declaration identlist nil) - - ;; First attempt: we might already be on the declaration of the identifier - ;; We want to look for the declaration only in a definite interval (after - ;; the "^X ..." line for the current file, and before the next "^X" line - - (if (re-search-forward - (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) - nil t) - (let ((bound (save-excursion (re-search-forward "^X " nil t)))) - (setq declaration-found - (re-search-forward - (concat "^" (ada-line-of identlist) - "." (ada-column-of identlist) - "[ *]" (ada-name-of identlist) - "[{[(<= ]?\\(.*\\)$") bound t)) - (if declaration-found - (ada-set-on-declaration identlist t)) - )) - - ;; If declaration is still nil, then we were not on a declaration, and - ;; have to fall back on other algorithms - - (unless declaration-found - - ;; Since we already know the number of the file, search for a direct - ;; reference to it - (goto-char (point-min)) - (setq declaration-found t) - (ada-set-ali-index - identlist - (number-to-string (ada-find-file-number-in-ali - (ada-file-of identlist)))) - (unless (re-search-forward (concat (ada-ali-index-of identlist) - "|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? \\)*" - (ada-line-of identlist) - "[^etpzkd<>=^]" - (ada-column-of identlist) "\\>") - nil t) - - ;; if we did not find it, it may be because the first reference - ;; is not required to have a 'unit_number|' item included. - ;; Or maybe we are already on the declaration... - (unless (re-search-forward - (concat - "^[0-9]+.[0-9]+[ *]" - (ada-name-of identlist) - "[ <{=([]\\(.\\|\n\\.\\)*\\<" - (ada-line-of identlist) - "[^0-9]" - (ada-column-of identlist) "\\>") - nil t) - - ;; If still not found, then either the declaration is unknown - ;; or the source file has been modified since the ali file was - ;; created - (setq declaration-found nil) - ) - ) - - ;; Last check to be completely sure we have found the correct line (the - ;; ali might not be up to date for instance) - (if declaration-found - (progn - (beginning-of-line) - ;; while we have a continuation line, go up one line - (while (looking-at "^\\.") - (forward-line -1) - (beginning-of-line)) - (unless (looking-at (concat "[0-9]+.[0-9]+[ *]" - (ada-name-of identlist) "[ <{=([]")) - (setq declaration-found nil)))) - - ;; Still no success ! The ali file must be too old, and we need to - ;; use a basic algorithm based on guesses. Note that this only happens - ;; if the user does not want us to automatically recompile files - ;; automatically - (unless declaration-found - (if (ada-xref-find-in-modified-ali identlist) - (setq declaration-found t) - ;; No more idea to find the declaration. Give up - (progn - (kill-buffer ali-buffer) - - (error "No declaration of %s found" (ada-name-of identlist)) - ))) - ) - - - ;; Now that we have found a suitable line in the .ali file, get the - ;; information available - (beginning-of-line) - (if declaration-found - (let ((current-line (buffer-substring - (point) (point-at-eol)))) - (save-excursion - (forward-line 1) - (beginning-of-line) - (while (looking-at "^\\.\\(.*\\)") - (setq current-line (concat current-line (match-string 1))) - (forward-line 1)) - ) - - (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t) - - ;; If we can find the file - (condition-case err - (ada-set-declare-file - identlist - (ada-get-ada-file-name (match-string 1) - (ada-file-of identlist))) - - ;; Else clean up the ali file - (ada-error-file-not-found - (signal (car err) (cdr err))) - (error - (kill-buffer ali-buffer) - (error (error-message-string err))) - )) - - (ada-set-references identlist current-line) - )) - )) - -(defun ada-xref-find-in-modified-ali (identlist) - "Find the matching position for IDENTLIST in the current ali buffer. -This function is only called when the file was not up-to-date, so we need -to make some guesses. -This function is disabled for operators, and only works for identifiers." - - (unless (= (string-to-char (ada-name-of identlist)) ?\") - (progn - (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... )) - (my-regexp (concat "[ *]" - (regexp-quote (ada-name-of identlist)) " ")) - (line-ada "--") - (col-ada "--") - (line-ali 0) - (len 0) - (choice 0) - (ali-buffer (current-buffer))) - - (goto-char (point-max)) - (while (re-search-backward my-regexp nil t) - (save-excursion - (setq line-ali (count-lines 1 (point))) - (beginning-of-line) - ;; have a look at the line and column numbers - (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") - (progn - (setq line-ada (match-string 1)) - (setq col-ada (match-string 2))) - (setq line-ada "--") - (setq col-ada "--") - ) - ;; construct a list with the file names and the positions within - (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t) - (cl-pushnew (list line-ali (match-string 1) line-ada col-ada) - declist :test #'equal) - ) - ) - ) - - ;; how many possible declarations have we found ? - (setq len (length declist)) - (cond - ;; none => error - ((= len 0) - (kill-buffer (current-buffer)) - (error "No declaration of %s recorded in .ali file" - (ada-name-of identlist))) - ;; one => should be the right one - ((= len 1) - (goto-char (point-min)) - (forward-line (1- (caar declist)))) - - ;; more than one => display choice list - (t - (save-window-excursion - (with-output-to-temp-buffer "*choice list*" - - (princ "Identifier is overloaded and Xref information is not up to date.\n") - (princ "Possible declarations are:\n\n") - (princ " no. in file at line col\n") - (princ " --- --------------------- ---- ----\n") - (let ((counter 0)) - (while (< counter len) - (princ (format " %2d) %-21s %4s %4s\n" - (1+ counter) - (ada-get-ada-file-name - (nth 1 (nth counter declist)) - (ada-file-of identlist)) - (nth 2 (nth counter declist)) - (nth 3 (nth counter declist)) - )) - (setq counter (1+ counter)) - ) ; end of while - ) ; end of let - ) ; end of with-output-to ... - (setq choice nil) - (while (or - (not choice) - (not (integerp choice)) - (< choice 1) - (> choice len)) - (setq choice - (string-to-number - (read-from-minibuffer "Enter No. of your choice: ")))) - ) - (set-buffer ali-buffer) - (goto-char (point-min)) - (forward-line (1- (car (nth (1- choice) declist)))) - )))))) - - -(defun ada-find-in-ali (identlist &optional other-frame) - "Look in the .ali file for the definition of the identifier in IDENTLIST. -If OTHER-FRAME is non-nil, and `ada-xref-other-buffer' is non-nil, -opens a new window to show the declaration." - - (ada-get-all-references identlist) - (let ((ali-line (ada-references-of identlist)) - (locations nil) - (start 0) - file line col) - - ;; Note: in some cases, an entity can have multiple references to the - ;; bodies (this is for instance the case for a separate subprogram, that - ;; has a reference both to the stub and to the real body). - ;; In that case, we simply go to each one in turn. - - ;; Get all the possible locations - (string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line) - (setq locations (list (list (match-string 1 ali-line) ;; line - (match-string 2 ali-line) ;; column - (ada-declare-file-of identlist)))) - (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)" - ali-line start) - (setq line (match-string 1 ali-line) - col (match-string 3 ali-line) - start (match-end 3)) - - ;; it there was a file number in the same line - ;; Make sure we correctly handle the case where the first file reference - ;; on the line is the type reference. - ;; 1U2 T(2|2r3) 34r23 - (if (string-match (concat "[^{(<0-9]\\([0-9]+\\)|\\([^|bc]+\\)?" - (match-string 0 ali-line)) - ali-line) - (let ((file-number (match-string 1 ali-line))) - (goto-char (point-min)) - (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t - (string-to-number file-number)) - (setq file (match-string 1)) - ) - ;; Else get the nearest file - (setq file (ada-declare-file-of identlist))) - - (setq locations (append locations (list (list line col file))))) - - ;; Add the specs at the end again, so that from the last body we go to - ;; the specs - (setq locations (append locations (list (car locations)))) - - ;; Find the new location we want to go to. - ;; If we are on none of the locations listed, we simply go to the specs. - - (setq line (caar locations) - col (nth 1 (car locations)) - file (nth 2 (car locations))) - - (while locations - (if (and (string= (caar locations) (ada-line-of identlist)) - (string= (nth 1 (car locations)) (ada-column-of identlist)) - (string= (file-name-nondirectory (nth 2 (car locations))) - (file-name-nondirectory (ada-file-of identlist)))) - (setq locations (cadr locations) - line (car locations) - col (nth 1 locations) - file (nth 2 locations) - locations nil) - (setq locations (cdr locations)))) - - ;; Find the file in the source path - (setq file (ada-get-ada-file-name file (ada-file-of identlist))) - - ;; Kill the .ali buffer - (kill-buffer (current-buffer)) - - ;; Now go to the buffer - (ada-xref-change-buffer file - (string-to-number line) - (1- (string-to-number col)) - identlist - other-frame) - )) - -(defun ada-find-in-src-path (identlist &optional other-frame) - "More general function for cross-references. -This function should be used when the standard algorithm that parses the -.ali file has failed, either because that file was too old or even did not -exist. -This function attempts to find the possible declarations for the identifier -anywhere in the object path. -This command requires the external `grep' program to be available. - -This works well when one is using an external library and wants to find -the declaration and documentation of the subprograms one is using." -;; FIXME: what does this function do? - (let (list - (dirs (ada-xref-get-obj-dir-field)) - (regexp (concat "[ *]" (ada-name-of identlist))) - line column - choice - file) - - ;; Do the grep in all the directories. We do multiple shell - ;; commands instead of one in case there is no .ali file in one - ;; of the directory and the shell stops because of that. - - (with-current-buffer (get-buffer-create "*grep*") - (while dirs - (insert (shell-command-to-string - (concat - "grep -E -i -h " - (shell-quote-argument (concat "^X|" regexp "( |$)")) - " " - (shell-quote-argument (file-name-as-directory (car dirs))) - "*.ali"))) - (setq dirs (cdr dirs))) - - ;; Now parse the output - (setq case-fold-search t) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (save-excursion - (beginning-of-line) - (if (not (= (char-after) ?X)) - (progn - (looking-at "\\([0-9]+\\).\\([0-9]+\\)") - (setq line (match-string 1) - column (match-string 2)) - (re-search-backward "^X [0-9]+ \\(.*\\)$") - (setq file (list (match-string 1) line column)) - - ;; There could be duplicate choices, because of the structure - ;; of the .ali files - (unless (member file list) - (setq list (append list (list file)))))))) - - ;; Current buffer is still "*grep*" - (kill-buffer "*grep*") - ) - - ;; Now display the list of possible matches - (cond - - ;; No choice found => Error - ((null list) - (error "No cross-reference found, please recompile your file")) - - ;; Only one choice => Do the cross-reference - ((= (length list) 1) - (setq file (ada-find-src-file-in-dir (caar list))) - (if file - (ada-xref-change-buffer file - (string-to-number (nth 1 (car list))) - (string-to-number (nth 2 (car list))) - identlist - other-frame) - (error "%s not found in src_dir" (caar list))) - (message "This is only a (good) guess at the cross-reference.") - ) - - ;; Else, ask the user - (t - (save-window-excursion - (with-output-to-temp-buffer "*choice list*" - - (princ "Identifier is overloaded and Xref information is not up to date.\n") - (princ "Possible declarations are:\n\n") - (princ " no. in file at line col\n") - (princ " --- --------------------- ---- ----\n") - (let ((counter 0)) - (while (< counter (length list)) - (princ (format " %2d) %-21s %4s %4s\n" - (1+ counter) - (nth 0 (nth counter list)) - (nth 1 (nth counter list)) - (nth 2 (nth counter list)) - )) - (setq counter (1+ counter)) - ))) - (setq choice nil) - (while (or (not choice) - (not (integerp choice)) - (< choice 1) - (> choice (length list))) - (setq choice - (string-to-number - (read-from-minibuffer "Enter No. of your choice: ")))) - ) - (setq choice (1- choice)) - (kill-buffer "*choice list*") - - (setq file (ada-find-src-file-in-dir (car (nth choice list)))) - (if file - (ada-xref-change-buffer file - (string-to-number (nth 1 (nth choice list))) - (string-to-number (nth 2 (nth choice list))) - identlist - other-frame) - (signal 'ada-error-file-not-found (car (nth choice list)))) - (message "This is only a (good) guess at the cross-reference.") - )))) - -(defun ada-xref-change-buffer - (file line column identlist &optional other-frame) - "Select and display FILE, at LINE and COLUMN. -If we do not end on the same identifier as IDENTLIST, find the -closest match. Kills the .ali buffer at the end. -If OTHER-FRAME is non-nil, creates a new frame to show the file." - - (let (declaration-buffer) - - ;; Select and display the destination buffer - (if ada-xref-other-buffer - (if other-frame - (find-file-other-frame file) - (setq declaration-buffer (find-file-noselect file)) - (set-buffer declaration-buffer) - (switch-to-buffer-other-window declaration-buffer) - ) - (find-file file) - ) - - ;; move the cursor to the correct position - (push-mark) - (goto-char (point-min)) - (forward-line (1- line)) - (move-to-column column) - - ;; If we are not on the identifier, the ali file was not up-to-date. - ;; Try to find the nearest position where the identifier is found, - ;; this is probably the right one. - (unless (looking-at (ada-name-of identlist)) - (ada-xref-search-nearest (ada-name-of identlist))) - )) - - -(defun ada-xref-search-nearest (name) - "Search for NAME nearest to the position recorded in the Xref file. -Return the position of the declaration in the buffer, or nil if not found." - (let ((orgpos (point)) - (newpos nil) - (diff nil)) - - (goto-char (point-max)) - - ;; loop - look for all declarations of name in this file - (while (search-backward name nil t) - - ;; check if it really is a complete Ada identifier - (if (and - (not (save-excursion - (goto-char (match-end 0)) - (looking-at "_"))) - (not (ada-in-string-or-comment-p)) - (or - ;; variable declaration ? - (save-excursion - (skip-chars-forward "a-zA-Z_0-9" ) - (ada-goto-next-non-ws) - (looking-at ":[^=]")) - ;; procedure, function, task or package declaration ? - (save-excursion - (ada-goto-previous-word) - (looking-at "\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>")))) - - ;; check if it is nearer than the ones before if any - (if (or (not diff) - (< (abs (- (point) orgpos)) diff)) - (progn - (setq newpos (point) - diff (abs (- newpos orgpos)))))) - ) - - (if newpos - (progn - (message "ATTENTION: this declaration is only a (good) guess ...") - (goto-char newpos)) - nil))) - - -;; Find the parent library file of the current file -(defun ada-goto-parent () - "Go to the parent library file." - (interactive) - (ada-require-project-file) - - (let ((buffer (ada-get-ali-buffer (buffer-file-name))) - (unit-name nil) - (body-name nil) - (ali-name nil)) - (with-current-buffer buffer - (goto-char (point-min)) - (re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)") - (setq unit-name (match-string 1)) - (if (not (string-match "\\(.*\\)\\.[^.]+" unit-name)) - (progn - (kill-buffer buffer) - (error "No parent unit !")) - (setq unit-name (match-string 1 unit-name)) - ) - - ;; look for the file name for the parent unit specification - (goto-char (point-min)) - (re-search-forward (concat "^W " unit-name - "%s[ \t]+\\([^ \t]+\\)[ \t]+" - "\\([^ \t\n]+\\)")) - (setq body-name (match-string 1)) - (setq ali-name (match-string 2)) - (kill-buffer buffer) - ) - - (setq ali-name (ada-find-ali-file-in-dir ali-name)) - - (save-excursion - ;; Tries to open the new ali file to find the spec file - (if ali-name - (progn - (find-file ali-name) - (goto-char (point-min)) - (re-search-forward (concat "^U " unit-name "%s[ \t]+" - "\\([^ \t]+\\)")) - (setq body-name (match-string 1)) - (kill-buffer (current-buffer)) - ) - ) - ) - - (find-file body-name) - )) - -(defun ada-make-filename-from-adaname (adaname) - "Determine the filename in which ADANAME is found. -This is a GNAT specific function that uses gnatkrunch." - (let ((krunch-buf (generate-new-buffer "*gkrunch*")) - (cross-prefix (plist-get (cdr (ada-xref-current-project)) 'cross_prefix))) - (with-current-buffer krunch-buf - ;; send adaname to external process `gnatkr'. - ;; Add a dummy extension, since gnatkr versions have two different - ;; behaviors depending on the version: - ;; Up to 3.15: "AA.BB.CC" => aa-bb-cc - ;; After: "AA.BB.CC" => aa-bb.cc - (call-process (concat cross-prefix "gnatkr") nil krunch-buf nil - (concat adaname ".adb") ada-krunch-args) - ;; fetch output of that process - (setq adaname (buffer-substring - (point-min) - (progn - (goto-char (point-min)) - (end-of-line) - (point)))) - ;; Remove the extra extension we added above - (setq adaname (substring adaname 0 -4)) - - (kill-buffer krunch-buf))) - adaname - ) - -(defun ada-make-body-gnatstub (&optional interactive) - "Create an Ada package body in the current buffer. -This function uses the `gnat stub' program to create the body. -This function typically is to be hooked into `ff-file-created-hook'. -If INTERACTIVE is nil, assume this is called from `ff-file-created-hook'." - (interactive "p") - (ada-require-project-file) - - ;; If not interactive, assume we are being called from - ;; ff-file-created-hook. Then the current buffer is for the body - ;; file, but we will create a new one after gnat stub runs - (unless interactive - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - - (save-some-buffers nil nil) - - ;; Make sure the current buffer is the spec, so gnat stub gets the - ;; right package parameter (this might not be the case if for - ;; instance the user was asked for a project file) - - (unless (buffer-file-name (car (buffer-list))) - (set-buffer (cadr (buffer-list)))) - - ;; Call the external process - (let* ((project-plist (cdr (ada-xref-current-project))) - (gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts)) - (gpr-file (plist-get project-plist 'gpr_file)) - (filename (buffer-file-name (car (buffer-list)))) - (output (concat (file-name-sans-extension filename) ".adb")) - (cross-prefix (plist-get project-plist 'cross_prefix)) - (gnatstub-cmd (concat cross-prefix "gnat stub" - (if (not (string= gpr-file "")) - (concat " -P\"" gpr-file "\"")) - " " gnatstub-opts " " filename)) - (buffer (get-buffer-create "*gnat stub*"))) - - (with-current-buffer buffer - (compilation-minor-mode 1) - (erase-buffer) - (insert gnatstub-cmd) - (newline) - ) - - (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd) - - ;; clean up the output - - (if (file-exists-p output) - (progn - (find-file output) - (kill-buffer buffer)) - - ;; file not created; display the error message - (display-buffer buffer)))) - -(defun ada-xref-initialize () - "Function called by `ada-mode-hook' to initialize the ada-xref.el package. -For instance, it creates the gnat-specific menus, sets some hooks for -`find-file'." - (remove-hook 'ff-file-created-hook 'ada-make-body) ; from global hook - (remove-hook 'ff-file-created-hook 'ada-make-body t) ; from local hook - (add-hook 'ff-file-created-hook 'ada-make-body-gnatstub nil t) - - ;; Completion for file names in the mini buffer should ignore .ali files - (add-to-list 'completion-ignored-extensions ".ali") - - (ada-xref-update-project-menu) - ) - -;; ----- Add to ada-mode-hook --------------------------------------------- - -;; This must be done before initializing the Ada menu. -(add-hook 'ada-mode-hook 'ada-xref-initialize) - -;; Define a new error type -(define-error 'ada-error-file-not-found - "File not found in src-dir (check project file): " 'ada-mode-errors) - -(provide 'ada-xref) - -;;; ada-xref.el ends here diff --git a/old_ada/doc/ada-mode.html b/old_ada/doc/ada-mode.html deleted file mode 100644 index 6788acb..0000000 --- a/old_ada/doc/ada-mode.html +++ /dev/null @@ -1,2288 +0,0 @@ - - - - - - -Ada Mode - - - - - - - - - - - - - - - - - - -

Ada Mode

- - - - - -
-
-

-Next:   [Contents][Index]

-
-

Ada Mode

- -

Copyright © 1999–2019 Free Software Foundation, Inc. -

-
-

Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with no -Invariant Sections, with the Front-Cover Texts being “A GNU Manual”, -and with the Back-Cover Texts as in (a) below. A copy of the license -is included in the section entitled “GNU Free Documentation License”. -

-

(a) The FSF’s Back-Cover Text is: “You have the freedom to copy and -modify this GNU manual.” -

- - - - -
-
-
-

-Next: , Previous: , Up: Ada Mode   [Contents][Index]

-
-

1 Overview

- -

The Emacs mode for programming in Ada helps the user in understanding -existing code and facilitates writing new code. -

-

When the GNU Ada compiler GNAT is used, the cross-reference -information output by the compiler is used to provide powerful code -navigation (jump to definition, find all uses, etc.). -

-

When you open a file with a file extension of .ads or -.adb, Emacs will automatically load and activate Ada mode. -

-

Ada mode works without any customization, if you are using the GNAT -compiler (https://libre2.adacore.com/) and the GNAT default -naming convention. -

-

You must customize a few things if you are using a different compiler -or file naming convention; See Other compiler, See Non-standard file names. -

-

In addition, you may want to customize the indentation, -capitalization, and other things; See Other customization. -

-

Finally, for large Ada projects, you will want to set up an Emacs -Ada mode project file for each project; See Project files. Note -that these are different from the GNAT project files used by gnatmake -and other GNAT commands. -

-

See the Emacs info manual, section ’Running Debuggers Under Emacs’, -for general information on debugging. -

-
-
-
-
-

-Next: , Previous: , Up: Ada Mode   [Contents][Index]

-
-

2 Installation

- -

Ada mode is part of the standard Emacs distribution; if you use that, -no files need to be installed. -

-

Ada mode is also available as a separate distribution, from the Emacs -Ada mode website -http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html. The -separate distribution may be more recent. -

-

For installing the separate distribution, see the README file -in the distribution. -

-

To see what version of Ada mode you have installed, do M-x -ada-mode-version. -

-

The following files are provided with the Ada mode distribution: -

-
    -
  • ada-mode.el: The main file for Ada mode, providing indentation, -formatting of parameter lists, moving through code, comment handling -and automatic casing. - -
  • ada-prj.el: GUI editing of Ada mode project files, using Emacs -widgets. - -
  • ada-stmt.el: Ada statement templates. - -
  • ada-xref.el: GNAT cross-references, completion of identifiers, -and compilation. Also provides project files (which are not -GNAT-specific). - -
- -
-
-
-
-

-Next: , Previous: , Up: Ada Mode   [Contents][Index]

-
-

3 Customizing Ada mode

- -

Here we assume you are familiar with setting variables in Emacs, -either thru ’customize’ or in elisp (in your .emacs file). For -a basic introduction to customize, elisp, and Emacs in general, see -the tutorial in -The GNU Emacs Manual. -

-

These global Emacs settings are strongly recommended (put them in your -.emacs): -

-
-
(global-font-lock-mode t)
-(transient-mark-mode t)
-
- -

(global-font-lock-mode t)’ turns on syntax -highlighting for all buffers (it is off by default because it may be -too slow for some machines). -

-

(transient-mark-mode t)’ highlights selected text. -

-

See the Emacs help for each of these variables for more information. -

- - -
-
- -

3.1 Non-standard file names

- -

By default, Ada mode is configured to use the GNAT file naming -convention, where file names are a simple modification of the Ada -names, and the extension for specs and bodies are -‘.ads’ and ‘.adb’, respectively. -

-

Ada mode uses the file extensions to allow moving from a package body -to the corresponding spec and back. -

-

Ada mode supports a list of alternative file extensions for specs and bodies. -

-

For instance, if your spec and bodies files are called -unit_s.ada and unit_b.ada, respectively, you -can add the following to your .emacs file: -

-
-
(ada-add-extensions "_s.ada" "_b.ada")
-
- -

You can define additional extensions: -

-
-
(ada-add-extensions ".ads" "_b.ada")
-(ada-add-extensions ".ads" ".body")
-
- -

This means that whenever Ada mode looks for the body for a file -whose extension is .ads, it will take the first available file -that ends with either .adb, _b.ada or -.body. -

-

Similarly, if Ada mode is looking for a spec, it will look for -.ads or _s.ada. -

-

If the filename is not derived from the Ada name following the GNAT -convention, things are a little more complicated. You then need to -rewrite the function ada-make-filename-from-adaname. Doing that -is beyond the scope of this manual; see the current definitions in -ada-mode.el and ada-xref.el for examples. -

-
-
-
- -

3.2 Other compiler

- -

By default, Ada mode is configured to use the GNU Ada compiler GNAT. -

-

To use a different Ada compiler, you must specify the command lines -used to run that compiler, either in lisp variables or in Emacs -Ada mode project files. See Project file variables for the list -of project variables, and the corresponding lisp variables. -

-
-
-
- -

3.3 Other customization

- -

All user-settable Ada mode variables can be set via the menu -‘Ada | Customize’. Click on the ‘Help’ button there for help -on using customize. -

-

To modify a specific variable, you can directly call the function -customize-variable; just type M-x customize-variable -RET variable-name RET). -

-

Alternately, you can specify variable settings in the Emacs -configuration file, .emacs. This file is coded in Emacs lisp, -and the syntax to set a variable is the following: -

-
(setq variable-name value)
-
- -
-
-
-
-
-

-Next: , Previous: , Up: Ada Mode   [Contents][Index]

-
-

4 Compiling Executing

- -

Ada projects can be compiled, linked, and executed using commands on -the Ada menu. All of these commands can be customized via a project -file (see Project files), but the defaults are sufficient for using -the GNAT compiler for simple projects (single files, or several files -in a single directory). -

-

Even when no project file is used, the GUI project editor (menu -‘Ada | Project | Edit’) shows the settings of the various project -file variables referenced here. -

- - -
-
- -

4.1 Compile commands

- -

Here are the commands for building and using an Ada project, as -listed in the Ada menu. -

-

In multi-file projects, there must be one file that is the main -program. That is given by the main project file variable; -it defaults to the current file if not yet set, but is also set by the -“set main and build” command. -

-
-
Check file
-

Compiles the current file in syntax check mode, by running -check_cmd defined in the current project file. This typically -runs faster than full compile mode, speeding up finding and fixing -compilation errors. -

-

This sets main only if it has not been set yet. -

-
-
Compile file
-

Compiles the current file, by running comp_cmd from the current -project file. -

-

This does not set main. -

-
-
Set main and Build
-

Sets main to the current file, then executes the Build -command. -

-
-
Show main
-

Display main in the message buffer. -

-
-
Build
-

Compiles all obsolete units of the current main, and links -main, by running make_cmd from the current project. -

-

This sets main only if it has not been set yet. -

-
-
Run
-

Executes the main program in a shell, displayed in a separate Emacs -buffer. This runs run_cmd from the current project. The -execution buffer allows for interactive input/output. -

-

To modify the run command, in particular to provide or change the -command line arguments, type C-u before invoking the command. -

-

This command is not available for a cross-compilation toolchain. -

-
-
-

It is important when using these commands to understand how -main is used and changed. -

-

Build runs ’gnatmake’ on the main unit. During a typical edit/compile -session, this is the only command you need to invoke, which is why it -is bound to C-c C-c. It will compile all files needed by the -main unit, and display compilation errors in any of them. -

-

Note that Build can be invoked from any Ada buffer; typically you will -be fixing errors in files other than the main, but you don’t have to -switch back to the main to invoke the compiler again. -

-

Novices and students typically work on single-file Ada projects. In -this case, C-c C-m will normally be the only command needed; it -will build the current file, rather than the last-built main. -

-

There are three ways to change main: -

-
    -
  1. Invoke ‘Ada | Set main and Build’, which sets main to -the current file. - -
  2. Invoke ‘Ada | Project | Edit’, edit main and -main, and click ‘[save]’ - -
  3. Invoke ‘Ada | Project | Load’, and load a project file that specifies main - -
- -
-
-
- -

4.2 Compiler errors

- -

The Check file, Compile file, and Build commands -all place compilation errors in a separate buffer named -*compilation*. -

-

Each line in this buffer will become active: you can simply click on -it with the middle button of the mouse, or move point to it and press -RET. Emacs will then display the relevant source file and put -point on the line and column where the error was found. -

-

You can also press the C-x ` key (next-error), and Emacs -will jump to the first error. If you press that key again, it will -move you to the second error, and so on. -

-

Some error messages might also include references to other files. These -references are also clickable in the same way, or put point after the -line number and press RET. -

-
-
-
-
- -

5 Project files

- -

An Emacs Ada mode project file specifies what directories hold sources -for your project, and allows you to customize the compilation commands -and other things on a per-project basis. -

-

Note that Ada mode project files *.adp are different than GNAT -compiler project files *.gpr. However, Emacs Ada mode can use a -GNAT project file to specify the project directories. If no -other customization is needed, a GNAT project file can be used without -an Emacs Ada mode project file. -

- - -
-
-
-

-Next: , Up: Project files   [Contents][Index]

-
-

5.1 Project File Overview

- -

Project files have a simple syntax; they may be edited directly. Each -line specifies a project variable name and its value, separated by “=”: -

-
src_dir=/Projects/my_project/src_1
-src_dir=/Projects/my_project/src_2
-
- -

Some variables (like src_dir) are lists; multiple occurrences -are concatenated. -

-

There must be no space between the variable name and “=”, and no -trailing spaces. -

-

Alternately, a GUI editor for project files is available (see GUI Editor). It uses Emacs widgets, similar to Emacs customize. -

-

The GUI editor also provides a convenient way to view current project -settings, if they have been modified using menu commands rather than -by editing the project file. -

-

After the first Ada mode build command is invoked, there is always a -current project file, given by the lisp variable -ada-prj-default-project-file. Currently, the only way to show -the current project file is to invoke the GUI editor. -

-

To find the project file the first time, Ada mode uses the following -search algorithm: -

-
    -
  • If ada-prj-default-project-file is set, use that. - -
  • Otherwise, search for a file in the current directory with -the same base name as the Ada file, but extension given by -ada-prj-file-extension (default ".adp"). - -
  • If not found, search for *.adp in the current directory; if -several are found, prompt the user to select one. - -
  • If none are found, use default.adp in the current directory (even -if it does not exist). - -
- -

This algorithm always sets ada-prj-default-project-file, even -when the file does not actually exist. -

-

To change the project file before or after the first one is found, -invoke ‘Ada | Project | Load ...’. -

-

Or, in lisp, evaluate (ada-set-default-project-file "/path/file.adp"). -This sets ada-prj-default-project-file, and reads the project file. -

-

You can also specify a GNAT project file to ‘Ada | Project | Load -...’ or ada-set-default-project-file. Emacs Ada mode checks the -file extension; if it is .gpr, the file is treated as a GNAT -project file. Any other extension is treated as an Emacs Ada mode -project file. -

-
-
-
- -

5.2 GUI Editor

- -

The project file editor is invoked with the menu ‘Ada | Projects -| Edit’. -

-

Once in the buffer for editing the project file, you can save your -modification using the ‘[save]’ button at the bottom of the -buffer, or the C-x C-s binding. To cancel your modifications, -kill the buffer or click on the ‘[cancel]’ button. -

-
-
-
-
-

-Previous: , Up: Project files   [Contents][Index]

-
-

5.3 Project file variables

- -

The following variables can be defined in a project file; some can -also be defined in lisp variables. -

-

To set a project variable that is a list, specify each element of the -list on a separate line in the project file. -

-

Any project variable can be referenced in other project variables, -using a shell-like notation. For instance, if the variable -comp_cmd contains ${comp_opt}, the value of the -comp_opt variable will be substituted when comp_cmd is -used. -

-

In addition, process environment variables can be referenced using the -same syntax, or the normal $var syntax. -

-

Most project variables have defaults that can be changed by setting -lisp variables; the table below identifies the lisp variable for each -project variable. Lisp variables corresponding to project variables -that are lists are lisp lists. -

-

In general, project variables are evaluated when referenced in -Emacs Ada mode commands. Relative file paths are expanded to -absolute relative to ${build_dir}. -

-

Here is the list of variables. In the default values, the current -directory "." is the project file directory. -

-
-
ada_project_path_sep [default: ":" or ";"]
-

Path separator for ADA_PROJECT_PATH. It defaults to the correct -value for a native implementation of GNAT for the current operating -system. The user must override this when using Windows native GNAT -with Cygwin Emacs, and perhaps in other cases. -

-

Lisp variable: ada-prj-ada-project-path-sep. -

-
-
ada_project_path [default: ""]
-

A list of directories to search for GNAT project files. -

-

If set, the ADA_PROJECT_PATH process environment variable is -set to this value in the Emacs process when the Emacs Ada mode project -is selected via menu ‘Ada | Project | Load’. -

-

For ada_project_path, relative file paths are expanded to -absolute when the Emacs Ada project file is read, rather than when the -project file is selected. -

-

For example if the project file is in the directory -/home/myproject, the environment variable GDS_ROOT is -set to /home/shared, and the project file contains: -

-
ada_project_path_sep=:
-ada_project_path=$GDS_ROOT/makerules
-ada_project_path=../opentoken
-
-

then as a result the environment variable ADA_PROJECT_PATH will -be set to "/home/shared/makerules:/home/opentoken/". -

-

The default value is not the current value of this environment -variable, because that will typically have been set by another -project, and will therefore be incorrect for this project. -

-

If you have the environment variable set correctly for all of your -projects, you do not need to set this project variable. -

-
-
bind_opt [default: ""]
-

Holds user binder options; used in the default build commands. -

-

Lisp variable: ada-prj-default-bind-opt. -

-
-
build_dir [default: "."]
-

The compile commands will be issued in this directory. -

-
-
casing [default: ("~/.emacs_case_exceptions")]
-

List of files containing casing exceptions. See the help on -ada-case-exception-file for more info. -

-

Lisp variable: ada-case-exception-file. -

-
-
check_cmd [default: "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current} -cargs ${comp_opt}"]
-

Command used to syntax check a single file. -The name of the file is substituted for full_current. -

-

Lisp variable: ada-prj-default-check-cmd -

-
-
comp_cmd [default: "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs ${comp_opt}"]
-

Command used to compile a single file. -The name of the file is substituted for full_current. -

-

Lisp variable: ada-prj-default-comp-cmd. -

-
-
comp_opt [default: "-gnatq -gnatQ"]
-

Holds user compiler options; used in the default compile commands. The -default value tells gnatmake to generate library files for -cross-referencing even when there are errors. -

-

If source code for the project is in multiple directories, the -appropriate compiler options must be added here. Set source search path for examples of this. Alternately, GNAT project files may -be used; Use GNAT project file. -

-

Lisp variable: ada-prj-default-comp-opt. -

-
-
cross_prefix [default: ""]
-

Name of target machine in a cross-compilation environment. Used in -default compile and build commands. -

-
-
debug_cmd [default: "${cross_prefix}gdb ${main}"]
-

Command used to debug the application -

-

Lisp variable: ada-prj-default-debugger. -

-
-
debug_post_cmd [default: ""]
-

Command executed after debug_cmd. -

-
-
debug_pre_cmd [default: "cd ${build_dir}"]
-

Command executed before debug_cmd. -

-
-
gnatfind_opt [default: "-rf"]
-

Holds user gnatfind options; used in the default find commands. -

-

Lisp variable: ada-prj-gnatfind-switches. -

-
-
gnatmake_opt [default: "-g"]
-

Holds user gnatmake options; used in the default build commands. -

-

Lisp variable: ada-prj-default-gnatmake-opt. -

-
-
gpr_file [default: ""]
-

Specify GNAT project file. -

-

If set, the source and object directories specified in the GNAT -project file are appended to src_dir and obj_dir. This -allows specifying Ada source directories with a GNAT project file, and -other source directories with the Emacs project file. -

-

In addition, -P{gpr_file} is added to the project variable -gnatmake_opt whenever it is referenced. With the default -project variables, this passes the project file to all gnatmake -commands. -

-

Lisp variable: ada-prj-default-gpr-file. -

- -
-
link_opt [default: ""]
-

Holds user linker options; used in the default build commands. -

-

Lisp variable: ada-prj-default-link-opt. -

-
-
main [default: current file]
-

Specifies the name of the executable file for the project; used in the -default build commands. -

-
-
make_cmd [default: "${cross_prefix}gnatmake -o ${main} ${main} ${gnatmake_opt} -cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}"]
-

Command used to build the application. -

-

Lisp variable: ada-prj-default-make-cmd. -

-
-
obj_dir [default: "."]
-

A list of directories to search for library files. Ada mode searches -this list for the ‘.ali’ files generated by GNAT that contain -cross-reference information. -

-

The compiler commands must place the ‘.ali’ files in one of these -directories; the default commands do that. -

-
-
remote_machine [default: ""]
-

Name of the machine to log into before issuing the compile and build -commands. If this variable is empty, the command will be run on the -local machine. -

-
-
run_cmd [default: "./${main}"]
-

Command used to run the application. -

-
-
src_dir [default: "."]
-

A list of directories to search for source files, both for compile -commands and source navigation. -

-
-
- -
-
-
-
-
-

-Next: , Previous: , Up: Ada Mode   [Contents][Index]

-
-

6 Compiling Examples

- -

We present several small projects, and walk thru the process of -compiling, linking, and running them. -

-

The first example illustrates more Ada mode features than the others; -you should work thru that example before doing the others. -

-

All of these examples assume you are using GNAT. -

-

The source for these examples is available on the Emacs Ada mode -website mentioned in See Installation. -

- - -
-
- -

6.1 No project files

-

This example uses no project files. -

-

First, create a directory Example_1, containing: -

-

hello.adb: -

-
-
with Ada.Text_IO;
-procedure Hello
-is begin
-   Put_Line("Hello from hello.adb");
-end Hello;
-
- -

Yes, this is missing “use Ada.Text_IO;” - we want to demonstrate -compiler error handling. -

-

hello_2.adb: -

-
-
with Hello_Pkg;
-procedure Hello_2
-is begin
-   Hello_Pkg.Say_Hello;
-end Hello_2;
-
- -

This file has no errors. -

-

hello_pkg.ads: -

-
-
package Hello_Pkg is
-   procedure Say_Hello;
-end Hello_Pkg;
-
- -

This file has no errors. -

-

hello_pkg.adb: -

-
-
with Ada.Text_IO;
-package Hello_Pkg is
-   procedure Say_Hello
-   is begin
-      Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb");
-   end Say_Hello;
-end Hello_Pkg;
-
- -

Yes, this is missing the keyword body; another compiler error -example. -

-

In buffer hello.adb, invoke ‘Ada | Check file’. You should -get a *compilation* buffer containing something like (the -directory paths will be different): -

-
-
cd c:/Examples/Example_1/
-gnatmake -u -c -gnatc -g c:/Examples/Example_1/hello.adb -cargs -gnatq -gnatQ
-gcc -c -Ic:/Examples/Example_1/ -gnatc -g -gnatq -gnatQ -I- c:/Examples/Example_1/hello.adb
-hello.adb:4:04: "Put_Line" is not visible
-hello.adb:4:04: non-visible declaration at a-textio.ads:264
-hello.adb:4:04: non-visible declaration at a-textio.ads:260
-gnatmake: "c:/Examples/Example_1/hello.adb" compilation error
-
- -

If you have enabled font-lock, the lines with actual errors (starting -with hello.adb) are highlighted, with the file name in red. -

-

Now type C-x ` (on a PC keyboard, ` is next to 1). -Or you can click the middle mouse button on the first error line. The -compilation buffer scrolls to put the first error on the top line, and -point is put at the place of the error in the hello.adb buffer. -

-

To fix the error, change the line to be -

-
-
    Ada.Text_IO.Put_Line ("hello from hello.adb");
-
- -

Now invoke ‘Ada | Show main’; this displays ‘Ada mode main: hello’. -

-

Now (in buffer hello.adb), invoke ‘Ada | Build’. You are -prompted to save the file (if you haven’t already). Then the -compilation buffer is displayed again, containing: -

-
-
cd c:/Examples/Example_1/
-gnatmake -o hello hello -g -cargs -gnatq -gnatQ -bargs  -largs
-gcc -c -g -gnatq -gnatQ hello.adb
-gnatbind -x hello.ali
-gnatlink hello.ali -o hello.exe -g
-
- -

The compilation has succeeded without errors; hello.exe now -exists in the same directory as hello.adb. -

-

Now invoke ‘Ada | Run’. A *run* buffer is displayed, -containing -

-
-
Hello from hello.adb
-
-Process run finished
-
- -

That completes the first part of this example. -

-

Now we will compile a multi-file project. Open the file -hello_2.adb, and invoke ‘Ada | Set main and Build’. This -finds an error in hello_pkg.adb: -

-
-
cd c:/Examples/Example_1/
-gnatmake -o hello_2 hello_2 -g -cargs -gnatq -gnatQ -bargs  -largs
-gcc -c -g -gnatq -gnatQ hello_pkg.adb
-hello_pkg.adb:2:08: keyword "body" expected here [see file name]
-gnatmake: "hello_pkg.adb" compilation error
-
- -

This demonstrates that gnatmake finds the files needed by the main -program. However, it cannot find files in a different directory, -unless you use an Emacs Ada mode project file to specify the other directories; -See Set source search path, or a GNAT project file; Use GNAT project file. -

-

Invoke ‘Ada | Show main’; this displays Ada mode main: hello_2. -

-

Move to the error with C-x `, and fix the error by adding body: -

-
-
package body Hello_Pkg is
-
- -

Now, while still in hello_pkg.adb, invoke ‘Ada | Build’. -gnatmake successfully builds hello_2. This demonstrates that -Emacs has remembered the main file, in the project variable -main, and used it for the Build command. -

-

Finally, again while in hello_pkg.adb, invoke ‘Ada | Run’. -The *run* buffer displays Hello from hello_pkg.adb. -

-

One final point. If you switch back to buffer hello.adb, and -invoke ‘Ada | Run’, hello_2.exe will be run. That is -because main is still set to hello_2, as you can -see when you invoke ‘Ada | Project | Edit’. -

-

There are three ways to change main: -

-
    -
  1. Invoke ‘Ada | Set main and Build’, which sets main to -the current file. - -
  2. Invoke ‘Ada | Project | Edit’, edit main, and click ‘[save]’ - -
  3. Invoke ‘Ada | Project | Load’, and load a project file that specifies main - -
- -
-
-
- -

6.2 Set compiler options

- -

This example illustrates using an Emacs Ada mode project file to set a -compiler option. -

-

If you have files from Example_1 open in Emacs, you should -close them so you don’t get confused. Use menu ‘File | Close -(current buffer)’. -

-

In directory Example_2, create these files: -

-

hello.adb: -

-
-
with Ada.Text_IO;
-procedure Hello
-is begin
-   Put_Line("Hello from hello.adb");
-end Hello;
-
- -

This is the same as hello.adb from Example_1. It has two -errors; missing “use Ada.Text_IO;”, and no space between -Put_Line and its argument list. -

-

hello.adp: -

-
-
comp_opt=-gnatyt
-
- -

This tells the GNAT compiler to check for token spacing; in -particular, there must be a space preceding a parenthesis. -

-

In buffer hello.adb, invoke ‘Ada | Project | Load...’, and -select Example_2/hello.adp. -

-

Then, again in buffer hello.adb, invoke ‘Ada | Set main and -Build’. You should get a *compilation* buffer containing -something like (the directory paths will be different): -

-
-
cd c:/Examples/Example_2/
-gnatmake -o hello hello -g -cargs -gnatyt  -bargs  -largs
-gcc -c -g -gnatyt hello.adb
-hello.adb:4:04: "Put_Line" is not visible
-hello.adb:4:04: non-visible declaration at a-textio.ads:264
-hello.adb:4:04: non-visible declaration at a-textio.ads:260
-hello.adb:4:12: (style) space required
-gnatmake: "hello.adb" compilation error
-
- -

Compare this to the compiler output in No project files; the -gnatmake option -cargs -gnatq -gnatQ has been replaced by --cargs -gnaty, and an additional error is reported in -hello.adb on line 4. This shows that hello.adp is being -used to set the compiler options. -

-

Fixing the error, linking and running the code proceed as in No project files. -

-
-
-
- -

6.3 Set source search path

- -

In this example, we show how to deal with files in more than one -directory. We start with the same code as in No project files; -create those files (with the errors present) -

-

Create the directory Example_3, containing: -

-

hello_pkg.ads: -

-
-
package Hello_Pkg is
-   procedure Say_Hello;
-end Hello_Pkg;
-
- -

hello_pkg.adb: -

-
-
with Ada.Text_IO;
-package Hello_Pkg is
-   procedure Say_Hello
-   is begin
-      Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb");
-   end Say_Hello;
-end Hello_Pkg;
-
- -

These are the same files from example 1; hello_pkg.adb has an -error on line 2. -

-

In addition, create a directory Example_3/Other, containing these files: -

-

Other/hello_3.adb: -

-
-
with Hello_Pkg;
-with Ada.Text_IO; use Ada.Text_IO;
-procedure Hello_3
-is begin
-   Hello_Pkg.Say_Hello;
-   Put_Line ("From hello_3");
-end Hello_3;
-
- -

There are no errors in this file. -

-

Other/other.adp: -

-
-
src_dir=..
-comp_opt=-I..
-
- -

Note that there must be no trailing spaces. -

-

In buffer hello_3.adb, invoke ‘Ada | Project | Load...’, and -select Example_3/Other/other.adp. -

-

Then, again in hello_3.adb, invoke ‘Ada | Set main and -Build’. You should get a *compilation* buffer containing -something like (the directory paths will be different): -

-
-
cd c:/Examples/Example_3/Other/
-gnatmake -o hello_3 hello_3 -g -cargs -I.. -bargs  -largs
-gcc -c -g -I.. hello_3.adb
-gcc -c -I./ -g -I.. -I- C:\Examples\Example_3\hello_pkg.adb
-hello_pkg.adb:2:08: keyword "body" expected here [see file name]
-gnatmake: "C:\Examples\Example_3\hello_pkg.adb" compilation error
-
- -

Compare the -cargs option to the compiler output in Set compiler options; this shows that other.adp is being used to -set the compiler options. -

-

Move to the error with C-x `. Ada mode searches the list of -directories given by src_dir for the file mentioned in the -compiler error message. -

-

Fixing the error, linking and running the code proceed as in No project files. -

-
-
-
- -

6.4 Use GNAT project file

- -

In this example, we show how to use a GNAT project file, with no Ada -mode project file. -

-

Create the directory Example_4, containing: -

-

hello_pkg.ads: -

-
-
package Hello_Pkg is
-   procedure Say_Hello;
-end Hello_Pkg;
-
- -

hello_pkg.adb: -

-
-
with Ada.Text_IO;
-package Hello_Pkg is
-   procedure Say_Hello
-   is begin
-      Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb");
-   end Say_Hello;
-end Hello_Pkg;
-
- -

These are the same files from example 1; hello_pkg.adb has an -error on line 2. -

-

In addition, create a directory Example_4/Gnat_Project, -containing these files: -

-

Gnat_Project/hello_4.adb: -

-
-
with Hello_Pkg;
-with Ada.Text_IO; use Ada.Text_IO;
-procedure Hello_4
-is begin
-   Hello_Pkg.Say_Hello;
-   Put_Line ("From hello_4");
-end Hello_4;
-
- -

There are no errors in this file. -

-

Gnat_Project/hello_4.gpr: -

-
-
Project Hello_4 is
-   for Source_Dirs use (".", "..");
-end Hello_4;
-
- -

In buffer hello_4.adb, invoke ‘Ada | Project | Load...’, and -select Example_4/Gnat_Project/hello_4.gpr. -

-

Then, again in hello_4.adb, invoke ‘Ada | Set main and -Build’. You should get a *compilation* buffer containing -something like (the directory paths will be different): -

-
-
cd c:/Examples/Example_4/Gnat_Project/
-gnatmake -o hello_4 hello_4 -Phello_4.gpr -cargs -gnatq -gnatQ -bargs  -largs
-gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\Gnat_Project\hello_4.adb
-gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb
-hello_pkg.adb:2:08: keyword "body" expected here [see file name]
-gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error
-
- -

Compare the gcc options to the compiler output in Set compiler options; this shows that hello_4.gpr is being used to -set the compiler options. -

-

Fixing the error, linking and running the code proceed as in No project files. -

-
-
-
- -

6.5 Use multiple GNAT project files

- -

In this example, we show how to use multiple GNAT project files, -specifying the GNAT project search path in an Ada mode project file. -

-

Create the directory Example_4 as specified in Use GNAT project file. -

-

Create the directory Example_5, containing: -

-

hello_5.adb: -

-
-
with Hello_Pkg;
-with Ada.Text_IO; use Ada.Text_IO;
-procedure Hello_5
-is begin
-   Hello_Pkg.Say_Hello;
-   Put_Line ("From hello_5");
-end Hello_5;
-
- -

There are no errors in this file. -

-

hello_5.adp: -

-
-
ada_project_path=../Example_4/Gnat_Project
-gpr_file=hello_5.gpr
-
- -

hello_5.gpr: -

-
-
with "hello_4";
-Project Hello_5 is
-   for Source_Dirs use (".");
-   package Compiler is
-      for Default_Switches ("Ada") use ("-g", "-gnatyt");
-   end Compiler;
-end Hello_5;
-
- -

In buffer hello_5.adb, invoke ‘Ada | Project | Load...’, and -select Example_5/hello_5.adp. -

-

Then, again in hello_5.adb, invoke ‘Ada | Set main and -Build’. You should get a *compilation* buffer containing -something like (the directory paths will be different): -

-
-
cd c:/Examples/Example_5/
-gnatmake -o hello_5 hello_5 -Phello_5.gpr -g -cargs -gnatq -gnatQ -bargs  -largs
-gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_5\hello_5.adb
-gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb
-hello_pkg.adb:2:08: keyword "body" expected here [see file name]
-gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error
-
- -

Now type C-x `. Example_4/hello_pkg.adb is shown, -demonstrating that hello_5.gpr and hello_4.gpr are being -used to set the compilation search path. -

-
-
-
-
- -

7 Moving Through Ada Code

- -

There are several easy to use commands to navigate through Ada code. All -these functions are available through the Ada menu, and you can also -use the following key bindings or the command names. Some of these -menu entries are available only if the GNAT compiler is used, since -the implementation relies on the GNAT cross-referencing information. -

-
-
M-C-e
-

Move to the next function/procedure/task, which ever comes next -(ada-next-procedure). -

-
M-C-a
-

Move to previous function/procedure/task -(ada-previous-procedure). -

-
M-x ada-next-package
-

Move to next package. -

-
M-x ada-previous-package
-

Move to previous package. -

-
C-c C-a
-

Move to matching start of end (ada-move-to-start). If -point is at the end of a subprogram, this command jumps to the -corresponding begin if the user option -ada-move-to-declaration is nil (default), otherwise it jumps to -the subprogram declaration. -

-
C-c C-e
-

Move point to end of current block (ada-move-to-end). -

-
C-c o
-

Switch between corresponding spec and body file -(ff-find-other-file). If point is in a subprogram, position -point on the corresponding declaration or body in the other file. -

-
C-c c-d
-

Move from any reference to its declaration, for from a declaration to -its body (for procedures, tasks, private and incomplete types). -

-
C-c C-r
-

Runs the gnatfind command to search for all references to the -identifier surrounding point (ada-find-references). Use -C-x ` (next-error) to visit each reference (as for -compilation errors). -

-
- -

If the ada-xref-create-ali variable is non-nil, Emacs -will try to run GNAT for you whenever cross-reference information is -needed, and is older than the current source file. -

-
-
-
- -

8 Identifier completion

- -

Emacs and Ada mode provide two general ways for the completion of -identifiers. This is an easy way to type faster: you just have to type -the first few letters of an identifiers, and then loop through all the -possible completions. -

-

The first method is general for Emacs. It works by parsing all open -files for possible completions. -

-

For instance, if the words ‘my_identifier’, ‘my_subprogram’ -are the only words starting with ‘my’ in any of the opened files, -then you will have this scenario: -

-
-
You type:  myM-/
-Emacs inserts:  ‘my_identifier’
-If you press M-/ once again, Emacs replaces ‘my_identifier’ with
-‘my_subprogram’.
-Pressing M-/ once more will bring you back to ‘my_identifier’.
-
- -

This is a very fast way to do completion, and the casing of words will -also be respected. -

-

The second method (C-TAB) is specific to Ada mode and the GNAT -compiler. Emacs will search the cross-information for possible -completions. -

-

The main advantage is that this completion is more accurate: only -existing identifier will be suggested. -

-

On the other hand, this completion is a little bit slower and requires -that you have compiled your file at least once since you created that -identifier. -

-
-
C-TAB
-

Complete current identifier using cross-reference information. -

-
M-/
-

Complete identifier using buffer information (not Ada-specific). -

-
- -
-
-
- -

9 Automatic Smart Indentation

- -

Ada mode comes with a full set of rules for automatic indentation. You -can also configure the indentation, via the following variables: -

-
-
ada-broken-indent (default value: 2)
-

Number of columns to indent the continuation of a broken line. -

-
-
ada-indent (default value: 3)
-

Number of columns for default indentation. -

-
-
ada-indent-record-rel-type (default value: 3)
-

Indentation for record relative to type or use. -

-
-
ada-indent-return (default value: 0)
-

Indentation for return relative to function (if -ada-indent-return is greater than 0), or the open parenthesis -(if ada-indent-return is negative or 0). Note that in the second -case, when there is no open parenthesis, the indentation is done -relative to function with the value of ada-broken-indent. -

-
-
ada-label-indent (default value: -4)
-

Number of columns to indent a label. -

-
-
ada-stmt-end-indent (default value: 0)
-

Number of columns to indent a statement end keyword on a separate line. -

-
-
ada-when-indent (default value: 3)
-

Indentation for when relative to exception or case. -

-
-
ada-indent-is-separate (default value: t)
-

Non-nil means indent is separate or is abstract if on a single line. -

-
-
ada-indent-to-open-paren (default value: t)
-

Non-nil means indent according to the innermost open parenthesis. -

-
-
ada-indent-after-return (default value: t)
-

Non-nil means that the current line will also be re-indented -before inserting a newline, when you press RET. -

-
- -

Most of the time, the indentation will be automatic, i.e., when you -press RET, the cursor will move to the correct column on the -next line. -

-

You can also indent single lines, or the current region, with TAB. -

-

Another mode of indentation exists that helps you to set up your -indentation scheme. If you press C-c TAB, Ada mode will do -the following: -

-
    -
  • Reindent the current line, as TAB would do. -
  • Temporarily move the cursor to a reference line, i.e., the line that -was used to calculate the current indentation. -
  • Display in the message window the name of the variable that provided -the offset for the indentation. -
- -

The exact indentation of the current line is the same as the one for the -reference line, plus an offset given by the variable. -

-
-
TAB
-

Indent the current line or the current region. -

-
C-M-\
-

Indent lines in the current region. -

-
C-c TAB
-

Indent the current line and display the name of the variable used for -indentation. -

-
- -
-
-
- -

10 Formatting Parameter Lists

- -
-
C-c C-f
-

Format the parameter list (ada-format-paramlist). -

-
- -

This aligns the declarations on the colon (‘:’) separating -argument names and argument types, and aligns the in, -out and in out keywords. -

-
-
-
- -

11 Automatic Casing

- -

Casing of identifiers, attributes and keywords is automatically -performed while typing when the variable ada-auto-case is set. -Every time you press a word separator, the previous word is -automatically cased. -

-

You can customize the automatic casing differently for keywords, -attributes and identifiers. The relevant variables are the following: -ada-case-keyword, ada-case-attribute and -ada-case-identifier. -

-

All these variables can have one of the following values: -

-
-
downcase-word
-

The word will be lowercase. For instance My_vARIable is -converted to my_variable. -

-
-
upcase-word
-

The word will be uppercase. For instance My_vARIable is -converted to MY_VARIABLE. -

-
-
ada-capitalize-word
-

The first letter and each letter following an underscore (‘_’) -are uppercase, others are lowercase. For instance My_vARIable -is converted to My_Variable. -

-
-
ada-loose-case-word
-

Characters after an underscore ‘_’ character are uppercase, -others are not modified. For instance My_vARIable is converted -to My_VARIable. -

-
- -

Ada mode allows you to define exceptions to these rules, in a file -specified by the variable ada-case-exception-file -(default ~/.emacs_case_exceptions). Each line in this file -specifies the casing of one word or word fragment. Comments may be -included, separated from the word by a space. -

-

If the word starts with an asterisk (‘*’), it defines the casing -as a word fragment (or “substring”); part of a word between two -underscores or word boundary. -

-

For example: -

-
-
DOD        Department of Defense
-*IO
-GNAT       The GNAT compiler from Ada Core Technologies
-
- -

The word fragment *IO applies to any word containing “_io”; -Text_IO, Hardware_IO, etc. -

- -

There are two ways to add new items to this file: you can simply edit -it as you would edit any text file. Or you can position point on the -word you want to add, and select menu ‘Ada | Edit | Create Case -Exception’, or press C-c C-y (ada-create-case-exception). -The word will automatically be added to the current list of exceptions -and to the file. -

-

To define a word fragment case exception, select the word fragment, -then select menu ‘Ada | Edit | Create Case Exception Substring’. -

-

It is sometimes useful to have multiple exception files around (for -instance, one could be the standard Ada acronyms, the second some -company specific exceptions, and the last one some project specific -exceptions). If you set up the variable ada-case-exception-file -as a list of files, each of them will be parsed and used in your emacs -session. However, when you save a new exception through the menu, as -described above, the new exception will be added to the first file in -the list. -

-
-
C-c C-b
-

Adjust case in the whole buffer (ada-adjust-case-buffer). -

-
C-c C-y
-

Create a new entry in the exception dictionary, with the word under -the cursor (ada-create-case-exception) -

-
C-c C-t
-

Rereads the exception dictionary from the file -ada-case-exception-file (ada-case-read-exceptions). -

-
- -
-
-
-
-

-Next: , Previous: , Up: Ada Mode   [Contents][Index]

-
-

12 Statement Templates

- -

Templates are defined for most Ada statements, using the Emacs -“skeleton” package. They can be inserted in the buffer using the -following commands: -

-
-
C-c t b
-

exception Block (ada-exception-block). -

-
C-c t c
-

case (ada-case). -

-
C-c t d
-

declare Block (ada-declare-block). -

-
C-c t e
-

else (ada-else). -

-
C-c t f
-

for Loop (ada-for-loop). -

-
C-c t h
-

Header (ada-header). -

-
C-c t i
-

if (ada-if). -

-
C-c t k
-

package Body (ada-package-body). -

-
C-c t l
-

loop (ada-loop). -

-
C-c p
-

subprogram body (ada-subprogram-body). -

-
C-c t t
-

task Body (ada-task-body). -

-
C-c t w
-

while Loop (ada-while). -

-
C-c t u
-

use (ada-use). -

-
C-c t x
-

exit (ada-exit). -

-
C-c t C-a
-

array (ada-array). -

-
C-c t C-e
-

elsif (ada-elsif). -

-
C-c t C-f
-

function Spec (ada-function-spec). -

-
C-c t C-k
-

package Spec (ada-package-spec). -

-
C-c t C-p
-

procedure Spec (ada-package-spec. -

-
C-c t C-r
-

record (ada-record). -

-
C-c t C-s
-

subtype (ada-subtype). -

-
C-c t C-t
-

task Spec (ada-task-spec). -

-
C-c t C-u
-

with (ada-with). -

-
C-c t C-v
-

private (ada-private). -

-
C-c t C-w
-

when (ada-when). -

-
C-c t C-x
-

exception (ada-exception). -

-
C-c t C-y
-

type (ada-type). -

-
- -
-
-
- -

13 Comment Handling

- -

By default, comment lines get indented like Ada code. There are a few -additional functions to handle comments: -

-
-
M-;
-

Start a comment in default column. -

-
M-j
-

Continue comment on next line. -

-
C-c ;
-

Comment the selected region (add ‘--’ at the beginning of lines). -

-
C-c :
-

Uncomment the selected region -

-
M-q
-

autofill the current comment. -

-
- -
-
-
-
-

-Next: , Previous: , Up: Ada Mode   [Contents][Index]

-
-

Appendix A GNU Free Documentation License

-
Version 1.3, 3 November 2008 -
- -
-
Copyright © 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
-https://fsf.org/
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-
- -
    -
  1. PREAMBLE - -

    The purpose of this License is to make a manual, textbook, or other -functional and useful document free in the sense of freedom: to -assure everyone the effective freedom to copy and redistribute it, -with or without modifying it, either commercially or noncommercially. -Secondarily, this License preserves for the author and publisher a way -to get credit for their work, while not being considered responsible -for modifications made by others. -

    -

    This License is a kind of “copyleft”, which means that derivative -works of the document must themselves be free in the same sense. It -complements the GNU General Public License, which is a copyleft -license designed for free software. -

    -

    We have designed this License in order to use it for manuals for free -software, because free software needs free documentation: a free -program should come with manuals providing the same freedoms that the -software does. But this License is not limited to software manuals; -it can be used for any textual work, regardless of subject matter or -whether it is published as a printed book. We recommend this License -principally for works whose purpose is instruction or reference. -

    -
  2. APPLICABILITY AND DEFINITIONS - -

    This License applies to any manual or other work, in any medium, that -contains a notice placed by the copyright holder saying it can be -distributed under the terms of this License. Such a notice grants a -world-wide, royalty-free license, unlimited in duration, to use that -work under the conditions stated herein. The “Document”, below, -refers to any such manual or work. Any member of the public is a -licensee, and is addressed as “you”. You accept the license if you -copy, modify or distribute the work in a way requiring permission -under copyright law. -

    -

    A “Modified Version” of the Document means any work containing the -Document or a portion of it, either copied verbatim, or with -modifications and/or translated into another language. -

    -

    A “Secondary Section” is a named appendix or a front-matter section -of the Document that deals exclusively with the relationship of the -publishers or authors of the Document to the Document’s overall -subject (or to related matters) and contains nothing that could fall -directly within that overall subject. (Thus, if the Document is in -part a textbook of mathematics, a Secondary Section may not explain -any mathematics.) The relationship could be a matter of historical -connection with the subject or with related matters, or of legal, -commercial, philosophical, ethical or political position regarding -them. -

    -

    The “Invariant Sections” are certain Secondary Sections whose titles -are designated, as being those of Invariant Sections, in the notice -that says that the Document is released under this License. If a -section does not fit the above definition of Secondary then it is not -allowed to be designated as Invariant. The Document may contain zero -Invariant Sections. If the Document does not identify any Invariant -Sections then there are none. -

    -

    The “Cover Texts” are certain short passages of text that are listed, -as Front-Cover Texts or Back-Cover Texts, in the notice that says that -the Document is released under this License. A Front-Cover Text may -be at most 5 words, and a Back-Cover Text may be at most 25 words. -

    -

    A “Transparent” copy of the Document means a machine-readable copy, -represented in a format whose specification is available to the -general public, that is suitable for revising the document -straightforwardly with generic text editors or (for images composed of -pixels) generic paint programs or (for drawings) some widely available -drawing editor, and that is suitable for input to text formatters or -for automatic translation to a variety of formats suitable for input -to text formatters. A copy made in an otherwise Transparent file -format whose markup, or absence of markup, has been arranged to thwart -or discourage subsequent modification by readers is not Transparent. -An image format is not Transparent if used for any substantial amount -of text. A copy that is not “Transparent” is called “Opaque”. -

    -

    Examples of suitable formats for Transparent copies include plain -ASCII without markup, Texinfo input format, LaTeX input -format, SGML or XML using a publicly available -DTD, and standard-conforming simple HTML, -PostScript or PDF designed for human modification. Examples -of transparent image formats include PNG, XCF and -JPG. Opaque formats include proprietary formats that can be -read and edited only by proprietary word processors, SGML or -XML for which the DTD and/or processing tools are -not generally available, and the machine-generated HTML, -PostScript or PDF produced by some word processors for -output purposes only. -

    -

    The “Title Page” means, for a printed book, the title page itself, -plus such following pages as are needed to hold, legibly, the material -this License requires to appear in the title page. For works in -formats which do not have any title page as such, “Title Page” means -the text near the most prominent appearance of the work’s title, -preceding the beginning of the body of the text. -

    -

    The “publisher” means any person or entity that distributes copies -of the Document to the public. -

    -

    A section “Entitled XYZ” means a named subunit of the Document whose -title either is precisely XYZ or contains XYZ in parentheses following -text that translates XYZ in another language. (Here XYZ stands for a -specific section name mentioned below, such as “Acknowledgements”, -“Dedications”, “Endorsements”, or “History”.) To “Preserve the Title” -of such a section when you modify the Document means that it remains a -section “Entitled XYZ” according to this definition. -

    -

    The Document may include Warranty Disclaimers next to the notice which -states that this License applies to the Document. These Warranty -Disclaimers are considered to be included by reference in this -License, but only as regards disclaiming warranties: any other -implication that these Warranty Disclaimers may have is void and has -no effect on the meaning of this License. -

    -
  3. VERBATIM COPYING - -

    You may copy and distribute the Document in any medium, either -commercially or noncommercially, provided that this License, the -copyright notices, and the license notice saying this License applies -to the Document are reproduced in all copies, and that you add no other -conditions whatsoever to those of this License. You may not use -technical measures to obstruct or control the reading or further -copying of the copies you make or distribute. However, you may accept -compensation in exchange for copies. If you distribute a large enough -number of copies you must also follow the conditions in section 3. -

    -

    You may also lend copies, under the same conditions stated above, and -you may publicly display copies. -

    -
  4. COPYING IN QUANTITY - -

    If you publish printed copies (or copies in media that commonly have -printed covers) of the Document, numbering more than 100, and the -Document’s license notice requires Cover Texts, you must enclose the -copies in covers that carry, clearly and legibly, all these Cover -Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on -the back cover. Both covers must also clearly and legibly identify -you as the publisher of these copies. The front cover must present -the full title with all words of the title equally prominent and -visible. You may add other material on the covers in addition. -Copying with changes limited to the covers, as long as they preserve -the title of the Document and satisfy these conditions, can be treated -as verbatim copying in other respects. -

    -

    If the required texts for either cover are too voluminous to fit -legibly, you should put the first ones listed (as many as fit -reasonably) on the actual cover, and continue the rest onto adjacent -pages. -

    -

    If you publish or distribute Opaque copies of the Document numbering -more than 100, you must either include a machine-readable Transparent -copy along with each Opaque copy, or state in or with each Opaque copy -a computer-network location from which the general network-using -public has access to download using public-standard network protocols -a complete Transparent copy of the Document, free of added material. -If you use the latter option, you must take reasonably prudent steps, -when you begin distribution of Opaque copies in quantity, to ensure -that this Transparent copy will remain thus accessible at the stated -location until at least one year after the last time you distribute an -Opaque copy (directly or through your agents or retailers) of that -edition to the public. -

    -

    It is requested, but not required, that you contact the authors of the -Document well before redistributing any large number of copies, to give -them a chance to provide you with an updated version of the Document. -

    -
  5. MODIFICATIONS - -

    You may copy and distribute a Modified Version of the Document under -the conditions of sections 2 and 3 above, provided that you release -the Modified Version under precisely this License, with the Modified -Version filling the role of the Document, thus licensing distribution -and modification of the Modified Version to whoever possesses a copy -of it. In addition, you must do these things in the Modified Version: -

    -
      -
    1. Use in the Title Page (and on the covers, if any) a title distinct -from that of the Document, and from those of previous versions -(which should, if there were any, be listed in the History section -of the Document). You may use the same title as a previous version -if the original publisher of that version gives permission. - -
    2. List on the Title Page, as authors, one or more persons or entities -responsible for authorship of the modifications in the Modified -Version, together with at least five of the principal authors of the -Document (all of its principal authors, if it has fewer than five), -unless they release you from this requirement. - -
    3. State on the Title page the name of the publisher of the -Modified Version, as the publisher. - -
    4. Preserve all the copyright notices of the Document. - -
    5. Add an appropriate copyright notice for your modifications -adjacent to the other copyright notices. - -
    6. Include, immediately after the copyright notices, a license notice -giving the public permission to use the Modified Version under the -terms of this License, in the form shown in the Addendum below. - -
    7. Preserve in that license notice the full lists of Invariant Sections -and required Cover Texts given in the Document’s license notice. - -
    8. Include an unaltered copy of this License. - -
    9. Preserve the section Entitled “History”, Preserve its Title, and add -to it an item stating at least the title, year, new authors, and -publisher of the Modified Version as given on the Title Page. If -there is no section Entitled “History” in the Document, create one -stating the title, year, authors, and publisher of the Document as -given on its Title Page, then add an item describing the Modified -Version as stated in the previous sentence. - -
    10. Preserve the network location, if any, given in the Document for -public access to a Transparent copy of the Document, and likewise -the network locations given in the Document for previous versions -it was based on. These may be placed in the “History” section. -You may omit a network location for a work that was published at -least four years before the Document itself, or if the original -publisher of the version it refers to gives permission. - -
    11. For any section Entitled “Acknowledgements” or “Dedications”, Preserve -the Title of the section, and preserve in the section all the -substance and tone of each of the contributor acknowledgements and/or -dedications given therein. - -
    12. Preserve all the Invariant Sections of the Document, -unaltered in their text and in their titles. Section numbers -or the equivalent are not considered part of the section titles. - -
    13. Delete any section Entitled “Endorsements”. Such a section -may not be included in the Modified Version. - -
    14. Do not retitle any existing section to be Entitled “Endorsements” or -to conflict in title with any Invariant Section. - -
    15. Preserve any Warranty Disclaimers. -
    - -

    If the Modified Version includes new front-matter sections or -appendices that qualify as Secondary Sections and contain no material -copied from the Document, you may at your option designate some or all -of these sections as invariant. To do this, add their titles to the -list of Invariant Sections in the Modified Version’s license notice. -These titles must be distinct from any other section titles. -

    -

    You may add a section Entitled “Endorsements”, provided it contains -nothing but endorsements of your Modified Version by various -parties—for example, statements of peer review or that the text has -been approved by an organization as the authoritative definition of a -standard. -

    -

    You may add a passage of up to five words as a Front-Cover Text, and a -passage of up to 25 words as a Back-Cover Text, to the end of the list -of Cover Texts in the Modified Version. Only one passage of -Front-Cover Text and one of Back-Cover Text may be added by (or -through arrangements made by) any one entity. If the Document already -includes a cover text for the same cover, previously added by you or -by arrangement made by the same entity you are acting on behalf of, -you may not add another; but you may replace the old one, on explicit -permission from the previous publisher that added the old one. -

    -

    The author(s) and publisher(s) of the Document do not by this License -give permission to use their names for publicity for or to assert or -imply endorsement of any Modified Version. -

    -
  6. COMBINING DOCUMENTS - -

    You may combine the Document with other documents released under this -License, under the terms defined in section 4 above for modified -versions, provided that you include in the combination all of the -Invariant Sections of all of the original documents, unmodified, and -list them all as Invariant Sections of your combined work in its -license notice, and that you preserve all their Warranty Disclaimers. -

    -

    The combined work need only contain one copy of this License, and -multiple identical Invariant Sections may be replaced with a single -copy. If there are multiple Invariant Sections with the same name but -different contents, make the title of each such section unique by -adding at the end of it, in parentheses, the name of the original -author or publisher of that section if known, or else a unique number. -Make the same adjustment to the section titles in the list of -Invariant Sections in the license notice of the combined work. -

    -

    In the combination, you must combine any sections Entitled “History” -in the various original documents, forming one section Entitled -“History”; likewise combine any sections Entitled “Acknowledgements”, -and any sections Entitled “Dedications”. You must delete all -sections Entitled “Endorsements.” -

    -
  7. COLLECTIONS OF DOCUMENTS - -

    You may make a collection consisting of the Document and other documents -released under this License, and replace the individual copies of this -License in the various documents with a single copy that is included in -the collection, provided that you follow the rules of this License for -verbatim copying of each of the documents in all other respects. -

    -

    You may extract a single document from such a collection, and distribute -it individually under this License, provided you insert a copy of this -License into the extracted document, and follow this License in all -other respects regarding verbatim copying of that document. -

    -
  8. AGGREGATION WITH INDEPENDENT WORKS - -

    A compilation of the Document or its derivatives with other separate -and independent documents or works, in or on a volume of a storage or -distribution medium, is called an “aggregate” if the copyright -resulting from the compilation is not used to limit the legal rights -of the compilation’s users beyond what the individual works permit. -When the Document is included in an aggregate, this License does not -apply to the other works in the aggregate which are not themselves -derivative works of the Document. -

    -

    If the Cover Text requirement of section 3 is applicable to these -copies of the Document, then if the Document is less than one half of -the entire aggregate, the Document’s Cover Texts may be placed on -covers that bracket the Document within the aggregate, or the -electronic equivalent of covers if the Document is in electronic form. -Otherwise they must appear on printed covers that bracket the whole -aggregate. -

    -
  9. TRANSLATION - -

    Translation is considered a kind of modification, so you may -distribute translations of the Document under the terms of section 4. -Replacing Invariant Sections with translations requires special -permission from their copyright holders, but you may include -translations of some or all Invariant Sections in addition to the -original versions of these Invariant Sections. You may include a -translation of this License, and all the license notices in the -Document, and any Warranty Disclaimers, provided that you also include -the original English version of this License and the original versions -of those notices and disclaimers. In case of a disagreement between -the translation and the original version of this License or a notice -or disclaimer, the original version will prevail. -

    -

    If a section in the Document is Entitled “Acknowledgements”, -“Dedications”, or “History”, the requirement (section 4) to Preserve -its Title (section 1) will typically require changing the actual -title. -

    -
  10. TERMINATION - -

    You may not copy, modify, sublicense, or distribute the Document -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense, or distribute it is void, and -will automatically terminate your rights under this License. -

    -

    However, if you cease all violation of this License, then your license -from a particular copyright holder is reinstated (a) provisionally, -unless and until the copyright holder explicitly and finally -terminates your license, and (b) permanently, if the copyright holder -fails to notify you of the violation by some reasonable means prior to -60 days after the cessation. -

    -

    Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. -

    -

    Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, receipt of a copy of some or all of the same material does -not give you any rights to use it. -

    -
  11. FUTURE REVISIONS OF THIS LICENSE - -

    The Free Software Foundation may publish new, revised versions -of the GNU Free Documentation License from time to time. Such new -versions will be similar in spirit to the present version, but may -differ in detail to address new problems or concerns. See -https://www.gnu.org/licenses/. -

    -

    Each version of the License is given a distinguishing version number. -If the Document specifies that a particular numbered version of this -License “or any later version” applies to it, you have the option of -following the terms and conditions either of that specified version or -of any later version that has been published (not as a draft) by the -Free Software Foundation. If the Document does not specify a version -number of this License, you may choose any version ever published (not -as a draft) by the Free Software Foundation. If the Document -specifies that a proxy can decide which future versions of this -License can be used, that proxy’s public statement of acceptance of a -version permanently authorizes you to choose that version for the -Document. -

    -
  12. RELICENSING - -

    “Massive Multiauthor Collaboration Site” (or “MMC Site”) means any -World Wide Web server that publishes copyrightable works and also -provides prominent facilities for anybody to edit those works. A -public wiki that anybody can edit is an example of such a server. A -“Massive Multiauthor Collaboration” (or “MMC”) contained in the -site means any set of copyrightable works thus published on the MMC -site. -

    -

    “CC-BY-SA” means the Creative Commons Attribution-Share Alike 3.0 -license published by Creative Commons Corporation, a not-for-profit -corporation with a principal place of business in San Francisco, -California, as well as future copyleft versions of that license -published by that same organization. -

    -

    “Incorporate” means to publish or republish a Document, in whole or -in part, as part of another Document. -

    -

    An MMC is “eligible for relicensing” if it is licensed under this -License, and if all works that were first published under this License -somewhere other than this MMC, and subsequently incorporated in whole -or in part into the MMC, (1) had no cover texts or invariant sections, -and (2) were thus incorporated prior to November 1, 2008. -

    -

    The operator of an MMC Site may republish an MMC contained in the site -under CC-BY-SA on the same site at any time before August 1, 2009, -provided the MMC is eligible for relicensing. -

    -
- -

ADDENDUM: How to use this License for your documents

- -

To use this License in a document you have written, include a copy of -the License in the document and put the following copyright and -license notices just after the title page: -

-
-
  Copyright (C)  year  your name.
-  Permission is granted to copy, distribute and/or modify this document
-  under the terms of the GNU Free Documentation License, Version 1.3
-  or any later version published by the Free Software Foundation;
-  with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
-  Texts.  A copy of the license is included in the section entitled ``GNU
-  Free Documentation License''.
-
- -

If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, -replace the “with…Texts.” line with this: -

-
-
    with the Invariant Sections being list their titles, with
-    the Front-Cover Texts being list, and with the Back-Cover Texts
-    being list.
-
- -

If you have Invariant Sections without Cover Texts, or some other -combination of the three, merge those two alternatives to suit the -situation. -

-

If your document contains nontrivial examples of program code, we -recommend releasing these examples in parallel under your choice of -free software license, such as the GNU General Public License, -to permit their use in free software. -

- -
-
-
- -

Index

- -
Jump to:   A -   -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Index Entry  Section

A
ada-adjust-case-buffer: Automatic Casing
ada-array: Statement Templates
ada-case: Statement Templates
ada-case-read-exceptions: Automatic Casing
ada-complete-identifier: Identifier completion
ada-create-case-exception: Automatic Casing
ada-declare-block: Statement Templates
ada-else: Statement Templates
ada-elsif: Statement Templates
ada-exception: Statement Templates
ada-exception-block: Statement Templates
ada-exit: Statement Templates
ada-find-references: Moving Through Ada Code
ada-for-loop: Statement Templates
ada-format-paramlist: Formatting Parameter Lists
ada-function-spec: Statement Templates
ada-goto-declaration: Moving Through Ada Code
ada-header: Statement Templates
ada-if: Statement Templates
ada-loop: Statement Templates
ada-move-to-end: Moving Through Ada Code
ada-move-to-start: Moving Through Ada Code
ada-next-package: Moving Through Ada Code
ada-next-procedure: Moving Through Ada Code
ada-package-body: Statement Templates
ada-package-spec: Statement Templates
ada-previous-package: Moving Through Ada Code
ada-previous-procedure: Moving Through Ada Code
ada-private: Statement Templates
ada-procedure-spec: Statement Templates
ada-record: Statement Templates
ada-subprogram-body: Statement Templates
ada-subtype: Statement Templates
ada-task-body: Statement Templates
ada-task-spec: Statement Templates
ada-type: Statement Templates
ada-use: Statement Templates
ada-when: Statement Templates
ada-while: Statement Templates
ada-with: Statement Templates

-
Jump to:   A -   -
- -
-
- - - - - diff --git a/old_ada/doc/ada-mode.info b/old_ada/doc/ada-mode.info deleted file mode 100644 index e29172d..0000000 --- a/old_ada/doc/ada-mode.info +++ /dev/null @@ -1,1983 +0,0 @@ -This is ada-mode.info, produced by texi2any version 6.8 from -ada-mode.texi. - -Copyright © 1999–2019 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.3 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover Texts - being “A GNU Manual”, and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - “GNU Free Documentation License”. - - (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and - modify this GNU manual.” -INFO-DIR-SECTION Emacs editing modes -START-INFO-DIR-ENTRY -* Ada mode: (ada-mode). Emacs mode for editing and compiling Ada code. -END-INFO-DIR-ENTRY - - -File: ada-mode.info, Node: Top, Next: Overview, Up: (dir) - -Ada Mode -******** - -Copyright © 1999–2019 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.3 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover Texts - being “A GNU Manual”, and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - “GNU Free Documentation License”. - - (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and - modify this GNU manual.” - -* Menu: - -* Overview:: -* Installation:: Installing Ada mode on your system -* Customization:: Setting up Ada mode to your taste -* Compiling Executing:: Working with your application within Emacs -* Project files:: Describing the organization of your project -* Compiling Examples:: A small tutorial -* Moving Through Ada Code:: Moving easily through Ada sources -* Identifier completion:: Finishing words automatically -* Automatic Smart Indentation:: Indenting your code automatically as you type -* Formatting Parameter Lists:: Formatting subprograms’ parameter lists - automatically -* Automatic Casing:: Adjusting the case of words automatically -* Statement Templates:: Inserting code templates -* Comment Handling:: Reformatting comments easily -* GNU Free Documentation License:: The license for this documentation. -* Index:: - - -File: ada-mode.info, Node: Overview, Next: Installation, Prev: Top, Up: Top - -1 Overview -********** - -The Emacs mode for programming in Ada helps the user in understanding -existing code and facilitates writing new code. - - When the GNU Ada compiler GNAT is used, the cross-reference -information output by the compiler is used to provide powerful code -navigation (jump to definition, find all uses, etc.). - - When you open a file with a file extension of ‘.ads’ or ‘.adb’, Emacs -will automatically load and activate Ada mode. - - Ada mode works without any customization, if you are using the GNAT -compiler () and the GNAT default naming -convention. - - You must customize a few things if you are using a different compiler -or file naming convention; *Note Other compiler::, *Note Non-standard -file names::. - - In addition, you may want to customize the indentation, -capitalization, and other things; *Note Other customization::. - - Finally, for large Ada projects, you will want to set up an Emacs Ada -mode project file for each project; *Note Project files::. Note that -these are different from the GNAT project files used by gnatmake and -other GNAT commands. - - See the Emacs info manual, section ’Running Debuggers Under Emacs’, -for general information on debugging. - - -File: ada-mode.info, Node: Installation, Next: Customization, Prev: Overview, Up: Top - -2 Installation -************** - -Ada mode is part of the standard Emacs distribution; if you use that, no -files need to be installed. - - Ada mode is also available as a separate distribution, from the Emacs -Ada mode website -. The -separate distribution may be more recent. - - For installing the separate distribution, see the ‘README’ file in -the distribution. - - To see what version of Ada mode you have installed, do ‘M-x -ada-mode-version’. - - The following files are provided with the Ada mode distribution: - - • ‘ada-mode.el’: The main file for Ada mode, providing indentation, - formatting of parameter lists, moving through code, comment - handling and automatic casing. - - • ‘ada-prj.el’: GUI editing of Ada mode project files, using Emacs - widgets. - - • ‘ada-stmt.el’: Ada statement templates. - - • ‘ada-xref.el’: GNAT cross-references, completion of identifiers, - and compilation. Also provides project files (which are not - GNAT-specific). - - -File: ada-mode.info, Node: Customization, Next: Compiling Executing, Prev: Installation, Up: Top - -3 Customizing Ada mode -********************** - -Here we assume you are familiar with setting variables in Emacs, either -thru ’customize’ or in elisp (in your ‘.emacs’ file). For a basic -introduction to customize, elisp, and Emacs in general, see the tutorial -in *note The GNU Emacs Manual: (emacs)Top. - - These global Emacs settings are strongly recommended (put them in -your .emacs): - - (global-font-lock-mode t) - (transient-mark-mode t) - - ‘(global-font-lock-mode t)’ turns on syntax highlighting for all -buffers (it is off by default because it may be too slow for some -machines). - - ‘(transient-mark-mode t)’ highlights selected text. - - See the Emacs help for each of these variables for more information. - -* Menu: - -* Non-standard file names:: -* Other compiler:: -* Other customization:: - - -File: ada-mode.info, Node: Non-standard file names, Next: Other compiler, Up: Customization - -3.1 Non-standard file names -=========================== - -By default, Ada mode is configured to use the GNAT file naming -convention, where file names are a simple modification of the Ada names, -and the extension for specs and bodies are ‘.ads’ and ‘.adb’, -respectively. - - Ada mode uses the file extensions to allow moving from a package body -to the corresponding spec and back. - - Ada mode supports a list of alternative file extensions for specs and -bodies. - - For instance, if your spec and bodies files are called ‘UNIT_s.ada’ -and ‘UNIT_b.ada’, respectively, you can add the following to your -‘.emacs’ file: - - (ada-add-extensions "_s.ada" "_b.ada") - - You can define additional extensions: - - (ada-add-extensions ".ads" "_b.ada") - (ada-add-extensions ".ads" ".body") - - This means that whenever Ada mode looks for the body for a file whose -extension is ‘.ads’, it will take the first available file that ends -with either ‘.adb’, ‘_b.ada’ or ‘.body’. - - Similarly, if Ada mode is looking for a spec, it will look for ‘.ads’ -or ‘_s.ada’. - - If the filename is not derived from the Ada name following the GNAT -convention, things are a little more complicated. You then need to -rewrite the function ‘ada-make-filename-from-adaname’. Doing that is -beyond the scope of this manual; see the current definitions in -‘ada-mode.el’ and ‘ada-xref.el’ for examples. - - -File: ada-mode.info, Node: Other compiler, Next: Other customization, Prev: Non-standard file names, Up: Customization - -3.2 Other compiler -================== - -By default, Ada mode is configured to use the GNU Ada compiler GNAT. - - To use a different Ada compiler, you must specify the command lines -used to run that compiler, either in lisp variables or in Emacs Ada mode -project files. See *note Project file variables:: for the list of -project variables, and the corresponding lisp variables. - - -File: ada-mode.info, Node: Other customization, Prev: Other compiler, Up: Customization - -3.3 Other customization -======================= - -All user-settable Ada mode variables can be set via the menu ‘Ada | -Customize’. Click on the ‘Help’ button there for help on using -customize. - - To modify a specific variable, you can directly call the function -‘customize-variable’; just type ‘M-x customize-variable -VARIABLE-NAME ’). - - Alternately, you can specify variable settings in the Emacs -configuration file, ‘.emacs’. This file is coded in Emacs lisp, and the -syntax to set a variable is the following: - (setq variable-name value) - - -File: ada-mode.info, Node: Compiling Executing, Next: Project files, Prev: Customization, Up: Top - -4 Compiling Executing -********************* - -Ada projects can be compiled, linked, and executed using commands on the -Ada menu. All of these commands can be customized via a project file -(*note Project files::), but the defaults are sufficient for using the -GNAT compiler for simple projects (single files, or several files in a -single directory). - - Even when no project file is used, the GUI project editor (menu ‘Ada -| Project | Edit’) shows the settings of the various project file -variables referenced here. - -* Menu: - -* Compile commands:: -* Compiler errors:: - - -File: ada-mode.info, Node: Compile commands, Next: Compiler errors, Up: Compiling Executing - -4.1 Compile commands -==================== - -Here are the commands for building and using an Ada project, as listed -in the Ada menu. - - In multi-file projects, there must be one file that is the main -program. That is given by the ‘main’ project file variable; it defaults -to the current file if not yet set, but is also set by the “set main and -build” command. - -‘Check file’ - Compiles the current file in syntax check mode, by running - ‘check_cmd’ defined in the current project file. This typically - runs faster than full compile mode, speeding up finding and fixing - compilation errors. - - This sets ‘main’ only if it has not been set yet. - -‘Compile file’ - Compiles the current file, by running ‘comp_cmd’ from the current - project file. - - This does not set ‘main’. - -‘Set main and Build’ - Sets ‘main’ to the current file, then executes the Build command. - -‘Show main’ - Display ‘main’ in the message buffer. - -‘Build’ - Compiles all obsolete units of the current ‘main’, and links - ‘main’, by running ‘make_cmd’ from the current project. - - This sets ‘main’ only if it has not been set yet. - -‘Run’ - Executes the main program in a shell, displayed in a separate Emacs - buffer. This runs ‘run_cmd’ from the current project. The - execution buffer allows for interactive input/output. - - To modify the run command, in particular to provide or change the - command line arguments, type ‘C-u’ before invoking the command. - - This command is not available for a cross-compilation toolchain. - - It is important when using these commands to understand how ‘main’ is -used and changed. - - Build runs ’gnatmake’ on the main unit. During a typical -edit/compile session, this is the only command you need to invoke, which -is why it is bound to ‘C-c C-c’. It will compile all files needed by -the main unit, and display compilation errors in any of them. - - Note that Build can be invoked from any Ada buffer; typically you -will be fixing errors in files other than the main, but you don’t have -to switch back to the main to invoke the compiler again. - - Novices and students typically work on single-file Ada projects. In -this case, ‘C-c C-m’ will normally be the only command needed; it will -build the current file, rather than the last-built main. - - There are three ways to change ‘main’: - - 1. Invoke ‘Ada | Set main and Build’, which sets ‘main’ to the current - file. - - 2. Invoke ‘Ada | Project | Edit’, edit ‘main’ and ‘main’, and click - ‘[save]’ - - 3. Invoke ‘Ada | Project | Load’, and load a project file that - specifies ‘main’ - - -File: ada-mode.info, Node: Compiler errors, Prev: Compile commands, Up: Compiling Executing - -4.2 Compiler errors -=================== - -The ‘Check file’, ‘Compile file’, and ‘Build’ commands all place -compilation errors in a separate buffer named ‘*compilation*’. - - Each line in this buffer will become active: you can simply click on -it with the middle button of the mouse, or move point to it and press -. Emacs will then display the relevant source file and put point -on the line and column where the error was found. - - You can also press the ‘C-x `’ key (‘next-error’), and Emacs will -jump to the first error. If you press that key again, it will move you -to the second error, and so on. - - Some error messages might also include references to other files. -These references are also clickable in the same way, or put point after -the line number and press . - - -File: ada-mode.info, Node: Project files, Next: Compiling Examples, Prev: Compiling Executing, Up: Top - -5 Project files -*************** - -An Emacs Ada mode project file specifies what directories hold sources -for your project, and allows you to customize the compilation commands -and other things on a per-project basis. - - Note that Ada mode project files ‘*.adp’ are different than GNAT -compiler project files ‘*.gpr’. However, Emacs Ada mode can use a GNAT -project file to specify the project directories. If no other -customization is needed, a GNAT project file can be used without an -Emacs Ada mode project file. - -* Menu: - -* Project File Overview:: -* GUI Editor:: -* Project file variables:: - - -File: ada-mode.info, Node: Project File Overview, Next: GUI Editor, Up: Project files - -5.1 Project File Overview -========================= - -Project files have a simple syntax; they may be edited directly. Each -line specifies a project variable name and its value, separated by “=”: - src_dir=/Projects/my_project/src_1 - src_dir=/Projects/my_project/src_2 - - Some variables (like ‘src_dir’) are lists; multiple occurrences are -concatenated. - - There must be no space between the variable name and “=”, and no -trailing spaces. - - Alternately, a GUI editor for project files is available (*note GUI -Editor::). It uses Emacs widgets, similar to Emacs customize. - - The GUI editor also provides a convenient way to view current project -settings, if they have been modified using menu commands rather than by -editing the project file. - - After the first Ada mode build command is invoked, there is always a -current project file, given by the lisp variable -‘ada-prj-default-project-file’. Currently, the only way to show the -current project file is to invoke the GUI editor. - - To find the project file the first time, Ada mode uses the following -search algorithm: - - • If ‘ada-prj-default-project-file’ is set, use that. - - • Otherwise, search for a file in the current directory with the same - base name as the Ada file, but extension given by - ‘ada-prj-file-extension’ (default ‘".adp"’). - - • If not found, search for ‘*.adp’ in the current directory; if - several are found, prompt the user to select one. - - • If none are found, use ‘default.adp’ in the current directory (even - if it does not exist). - - This algorithm always sets ‘ada-prj-default-project-file’, even when -the file does not actually exist. - - To change the project file before or after the first one is found, -invoke ‘Ada | Project | Load ...’. - - Or, in lisp, evaluate ‘(ada-set-default-project-file -"/path/file.adp")’. This sets ‘ada-prj-default-project-file’, and reads -the project file. - - You can also specify a GNAT project file to ‘Ada | Project | Load -...’ or ‘ada-set-default-project-file’. Emacs Ada mode checks the file -extension; if it is ‘.gpr’, the file is treated as a GNAT project file. -Any other extension is treated as an Emacs Ada mode project file. - - -File: ada-mode.info, Node: GUI Editor, Next: Project file variables, Prev: Project File Overview, Up: Project files - -5.2 GUI Editor -============== - -The project file editor is invoked with the menu ‘Ada | Projects | -Edit’. - - Once in the buffer for editing the project file, you can save your -modification using the ‘[save]’ button at the bottom of the buffer, or -the ‘C-x C-s’ binding. To cancel your modifications, kill the buffer or -click on the ‘[cancel]’ button. - - -File: ada-mode.info, Node: Project file variables, Prev: GUI Editor, Up: Project files - -5.3 Project file variables -========================== - -The following variables can be defined in a project file; some can also -be defined in lisp variables. - - To set a project variable that is a list, specify each element of the -list on a separate line in the project file. - - Any project variable can be referenced in other project variables, -using a shell-like notation. For instance, if the variable ‘comp_cmd’ -contains ‘${comp_opt}’, the value of the ‘comp_opt’ variable will be -substituted when ‘comp_cmd’ is used. - - In addition, process environment variables can be referenced using -the same syntax, or the normal ‘$var’ syntax. - - Most project variables have defaults that can be changed by setting -lisp variables; the table below identifies the lisp variable for each -project variable. Lisp variables corresponding to project variables -that are lists are lisp lists. - - In general, project variables are evaluated when referenced in Emacs -Ada mode commands. Relative file paths are expanded to absolute -relative to ‘${build_dir}’. - - Here is the list of variables. In the default values, the current -directory ‘"."’ is the project file directory. - -‘ada_project_path_sep’ [default: ‘":" or ";"’] - Path separator for ‘ADA_PROJECT_PATH’. It defaults to the correct - value for a native implementation of GNAT for the current operating - system. The user must override this when using Windows native GNAT - with Cygwin Emacs, and perhaps in other cases. - - Lisp variable: ‘ada-prj-ada-project-path-sep’. - -‘ada_project_path’ [default: ‘""’] - A list of directories to search for GNAT project files. - - If set, the ‘ADA_PROJECT_PATH’ process environment variable is set - to this value in the Emacs process when the Emacs Ada mode project - is selected via menu ‘Ada | Project | Load’. - - For ‘ada_project_path’, relative file paths are expanded to - absolute when the Emacs Ada project file is read, rather than when - the project file is selected. - - For example if the project file is in the directory - ‘/home/myproject’, the environment variable ‘GDS_ROOT’ is set to - ‘/home/shared’, and the project file contains: - ada_project_path_sep=: - ada_project_path=$GDS_ROOT/makerules - ada_project_path=../opentoken - then as a result the environment variable ‘ADA_PROJECT_PATH’ will - be set to ‘"/home/shared/makerules:/home/opentoken/"’. - - The default value is not the current value of this environment - variable, because that will typically have been set by another - project, and will therefore be incorrect for this project. - - If you have the environment variable set correctly for all of your - projects, you do not need to set this project variable. - -‘bind_opt’ [default: ‘""’] - Holds user binder options; used in the default build commands. - - Lisp variable: ‘ada-prj-default-bind-opt’. - -‘build_dir’ [default: ‘"."’] - The compile commands will be issued in this directory. - -‘casing’ [default: ‘("~/.emacs_case_exceptions")’] - List of files containing casing exceptions. See the help on - ‘ada-case-exception-file’ for more info. - - Lisp variable: ‘ada-case-exception-file’. - -‘check_cmd’ [default: ‘"${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current} -cargs ${comp_opt}"’] - Command used to syntax check a single file. The name of the file - is substituted for ‘full_current’. - - Lisp variable: ‘ada-prj-default-check-cmd’ - -‘comp_cmd’ [default: ‘"${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs ${comp_opt}"’] - Command used to compile a single file. The name of the file is - substituted for ‘full_current’. - - Lisp variable: ‘ada-prj-default-comp-cmd’. - -‘comp_opt’ [default: ‘"-gnatq -gnatQ"’] - Holds user compiler options; used in the default compile commands. - The default value tells gnatmake to generate library files for - cross-referencing even when there are errors. - - If source code for the project is in multiple directories, the - appropriate compiler options must be added here. *note Set source - search path:: for examples of this. Alternately, GNAT project - files may be used; *note Use GNAT project file::. - - Lisp variable: ‘ada-prj-default-comp-opt’. - -‘cross_prefix’ [default: ‘""’] - Name of target machine in a cross-compilation environment. Used in - default compile and build commands. - -‘debug_cmd’ [default: ‘"${cross_prefix}gdb ${main}"’] - Command used to debug the application - - Lisp variable: ‘ada-prj-default-debugger’. - -‘debug_post_cmd’ [default: ‘""’] - Command executed after ‘debug_cmd’. - -‘debug_pre_cmd’ [default: ‘"cd ${build_dir}"’] - Command executed before ‘debug_cmd’. - -‘gnatfind_opt’ [default: ‘"-rf"’] - Holds user gnatfind options; used in the default find commands. - - Lisp variable: ‘ada-prj-gnatfind-switches’. - -‘gnatmake_opt’ [default: ‘"-g"’] - Holds user gnatmake options; used in the default build commands. - - Lisp variable: ‘ada-prj-default-gnatmake-opt’. - -‘gpr_file’ [default: ‘""’] - Specify GNAT project file. - - If set, the source and object directories specified in the GNAT - project file are appended to ‘src_dir’ and ‘obj_dir’. This allows - specifying Ada source directories with a GNAT project file, and - other source directories with the Emacs project file. - - In addition, ‘-P{gpr_file}’ is added to the project variable - ‘gnatmake_opt’ whenever it is referenced. With the default project - variables, this passes the project file to all gnatmake commands. - - Lisp variable: ‘ada-prj-default-gpr-file’. - -‘link_opt’ [default: ‘""’] - Holds user linker options; used in the default build commands. - - Lisp variable: ‘ada-prj-default-link-opt’. - -‘main’ [default: current file] - Specifies the name of the executable file for the project; used in - the default build commands. - -‘make_cmd’ [default: ‘"${cross_prefix}gnatmake -o ${main} ${main} ${gnatmake_opt} -cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}"’] - Command used to build the application. - - Lisp variable: ‘ada-prj-default-make-cmd’. - -‘obj_dir’ [default: ‘"."’] - A list of directories to search for library files. Ada mode - searches this list for the ‘.ali’ files generated by GNAT that - contain cross-reference information. - - The compiler commands must place the ‘.ali’ files in one of these - directories; the default commands do that. - -‘remote_machine’ [default: ‘""’] - Name of the machine to log into before issuing the compile and - build commands. If this variable is empty, the command will be run - on the local machine. - -‘run_cmd’ [default: ‘"./${main}"’] - Command used to run the application. - -‘src_dir’ [default: ‘"."’] - A list of directories to search for source files, both for compile - commands and source navigation. - - -File: ada-mode.info, Node: Compiling Examples, Next: Moving Through Ada Code, Prev: Project files, Up: Top - -6 Compiling Examples -******************** - -We present several small projects, and walk thru the process of -compiling, linking, and running them. - - The first example illustrates more Ada mode features than the others; -you should work thru that example before doing the others. - - All of these examples assume you are using GNAT. - - The source for these examples is available on the Emacs Ada mode -website mentioned in *Note Installation::. - -* Menu: - -* No project files:: Just menus -* Set compiler options:: A basic Ada mode project file -* Set source search path:: Source in multiple directories -* Use GNAT project file:: -* Use multiple GNAT project files:: - - -File: ada-mode.info, Node: No project files, Next: Set compiler options, Up: Compiling Examples - -6.1 No project files -==================== - -This example uses no project files. - - First, create a directory ‘Example_1’, containing: - - ‘hello.adb’: - - with Ada.Text_IO; - procedure Hello - is begin - Put_Line("Hello from hello.adb"); - end Hello; - - Yes, this is missing “use Ada.Text_IO;” - we want to demonstrate -compiler error handling. - - ‘hello_2.adb’: - - with Hello_Pkg; - procedure Hello_2 - is begin - Hello_Pkg.Say_Hello; - end Hello_2; - - This file has no errors. - - ‘hello_pkg.ads’: - - package Hello_Pkg is - procedure Say_Hello; - end Hello_Pkg; - - This file has no errors. - - ‘hello_pkg.adb’: - - with Ada.Text_IO; - package Hello_Pkg is - procedure Say_Hello - is begin - Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); - end Say_Hello; - end Hello_Pkg; - - Yes, this is missing the keyword ‘body’; another compiler error -example. - - In buffer ‘hello.adb’, invoke ‘Ada | Check file’. You should get a -‘*compilation*’ buffer containing something like (the directory paths -will be different): - - cd c:/Examples/Example_1/ - gnatmake -u -c -gnatc -g c:/Examples/Example_1/hello.adb -cargs -gnatq -gnatQ - gcc -c -Ic:/Examples/Example_1/ -gnatc -g -gnatq -gnatQ -I- c:/Examples/Example_1/hello.adb - hello.adb:4:04: "Put_Line" is not visible - hello.adb:4:04: non-visible declaration at a-textio.ads:264 - hello.adb:4:04: non-visible declaration at a-textio.ads:260 - gnatmake: "c:/Examples/Example_1/hello.adb" compilation error - - If you have enabled font-lock, the lines with actual errors (starting -with ‘hello.adb’) are highlighted, with the file name in red. - - Now type ‘C-x `’ (on a PC keyboard, <`> is next to <1>). Or you can -click the middle mouse button on the first error line. The compilation -buffer scrolls to put the first error on the top line, and point is put -at the place of the error in the ‘hello.adb’ buffer. - - To fix the error, change the line to be - - Ada.Text_IO.Put_Line ("hello from hello.adb"); - - Now invoke ‘Ada | Show main’; this displays ‘Ada mode main: hello’. - - Now (in buffer ‘hello.adb’), invoke ‘Ada | Build’. You are prompted -to save the file (if you haven’t already). Then the compilation buffer -is displayed again, containing: - - cd c:/Examples/Example_1/ - gnatmake -o hello hello -g -cargs -gnatq -gnatQ -bargs -largs - gcc -c -g -gnatq -gnatQ hello.adb - gnatbind -x hello.ali - gnatlink hello.ali -o hello.exe -g - - The compilation has succeeded without errors; ‘hello.exe’ now exists -in the same directory as ‘hello.adb’. - - Now invoke ‘Ada | Run’. A ‘*run*’ buffer is displayed, containing - - Hello from hello.adb - - Process run finished - - That completes the first part of this example. - - Now we will compile a multi-file project. Open the file -‘hello_2.adb’, and invoke ‘Ada | Set main and Build’. This finds an -error in ‘hello_pkg.adb’: - - cd c:/Examples/Example_1/ - gnatmake -o hello_2 hello_2 -g -cargs -gnatq -gnatQ -bargs -largs - gcc -c -g -gnatq -gnatQ hello_pkg.adb - hello_pkg.adb:2:08: keyword "body" expected here [see file name] - gnatmake: "hello_pkg.adb" compilation error - - This demonstrates that gnatmake finds the files needed by the main -program. However, it cannot find files in a different directory, unless -you use an Emacs Ada mode project file to specify the other directories; -*Note Set source search path::, or a GNAT project file; *note Use GNAT -project file::. - - Invoke ‘Ada | Show main’; this displays ‘Ada mode main: hello_2’. - - Move to the error with ‘C-x `’, and fix the error by adding ‘body’: - - package body Hello_Pkg is - - Now, while still in ‘hello_pkg.adb’, invoke ‘Ada | Build’. gnatmake -successfully builds ‘hello_2’. This demonstrates that Emacs has -remembered the main file, in the project variable ‘main’, and used it -for the Build command. - - Finally, again while in ‘hello_pkg.adb’, invoke ‘Ada | Run’. The -‘*run*’ buffer displays ‘Hello from hello_pkg.adb’. - - One final point. If you switch back to buffer ‘hello.adb’, and -invoke ‘Ada | Run’, ‘hello_2.exe’ will be run. That is because ‘main’ -is still set to ‘hello_2’, as you can see when you invoke ‘Ada | Project -| Edit’. - - There are three ways to change ‘main’: - - 1. Invoke ‘Ada | Set main and Build’, which sets ‘main’ to the current - file. - - 2. Invoke ‘Ada | Project | Edit’, edit ‘main’, and click ‘[save]’ - - 3. Invoke ‘Ada | Project | Load’, and load a project file that - specifies ‘main’ - - -File: ada-mode.info, Node: Set compiler options, Next: Set source search path, Prev: No project files, Up: Compiling Examples - -6.2 Set compiler options -======================== - -This example illustrates using an Emacs Ada mode project file to set a -compiler option. - - If you have files from ‘Example_1’ open in Emacs, you should close -them so you don’t get confused. Use menu ‘File | Close (current -buffer)’. - - In directory ‘Example_2’, create these files: - - ‘hello.adb’: - - with Ada.Text_IO; - procedure Hello - is begin - Put_Line("Hello from hello.adb"); - end Hello; - - This is the same as ‘hello.adb’ from ‘Example_1’. It has two errors; -missing “use Ada.Text_IO;”, and no space between ‘Put_Line’ and its -argument list. - - ‘hello.adp’: - - comp_opt=-gnatyt - - This tells the GNAT compiler to check for token spacing; in -particular, there must be a space preceding a parenthesis. - - In buffer ‘hello.adb’, invoke ‘Ada | Project | Load...’, and select -‘Example_2/hello.adp’. - - Then, again in buffer ‘hello.adb’, invoke ‘Ada | Set main and Build’. -You should get a ‘*compilation*’ buffer containing something like (the -directory paths will be different): - - cd c:/Examples/Example_2/ - gnatmake -o hello hello -g -cargs -gnatyt -bargs -largs - gcc -c -g -gnatyt hello.adb - hello.adb:4:04: "Put_Line" is not visible - hello.adb:4:04: non-visible declaration at a-textio.ads:264 - hello.adb:4:04: non-visible declaration at a-textio.ads:260 - hello.adb:4:12: (style) space required - gnatmake: "hello.adb" compilation error - - Compare this to the compiler output in *note No project files::; the -gnatmake option ‘-cargs -gnatq -gnatQ’ has been replaced by ‘-cargs --gnaty’, and an additional error is reported in ‘hello.adb’ on line 4. -This shows that ‘hello.adp’ is being used to set the compiler options. - - Fixing the error, linking and running the code proceed as in *note No -project files::. - - -File: ada-mode.info, Node: Set source search path, Next: Use GNAT project file, Prev: Set compiler options, Up: Compiling Examples - -6.3 Set source search path -========================== - -In this example, we show how to deal with files in more than one -directory. We start with the same code as in *note No project files::; -create those files (with the errors present) - - Create the directory ‘Example_3’, containing: - - ‘hello_pkg.ads’: - - package Hello_Pkg is - procedure Say_Hello; - end Hello_Pkg; - - ‘hello_pkg.adb’: - - with Ada.Text_IO; - package Hello_Pkg is - procedure Say_Hello - is begin - Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); - end Say_Hello; - end Hello_Pkg; - - These are the same files from example 1; ‘hello_pkg.adb’ has an error -on line 2. - - In addition, create a directory ‘Example_3/Other’, containing these -files: - - ‘Other/hello_3.adb’: - - with Hello_Pkg; - with Ada.Text_IO; use Ada.Text_IO; - procedure Hello_3 - is begin - Hello_Pkg.Say_Hello; - Put_Line ("From hello_3"); - end Hello_3; - - There are no errors in this file. - - ‘Other/other.adp’: - - src_dir=.. - comp_opt=-I.. - - Note that there must be no trailing spaces. - - In buffer ‘hello_3.adb’, invoke ‘Ada | Project | Load...’, and select -‘Example_3/Other/other.adp’. - - Then, again in ‘hello_3.adb’, invoke ‘Ada | Set main and Build’. You -should get a ‘*compilation*’ buffer containing something like (the -directory paths will be different): - - cd c:/Examples/Example_3/Other/ - gnatmake -o hello_3 hello_3 -g -cargs -I.. -bargs -largs - gcc -c -g -I.. hello_3.adb - gcc -c -I./ -g -I.. -I- C:\Examples\Example_3\hello_pkg.adb - hello_pkg.adb:2:08: keyword "body" expected here [see file name] - gnatmake: "C:\Examples\Example_3\hello_pkg.adb" compilation error - - Compare the ‘-cargs’ option to the compiler output in *note Set -compiler options::; this shows that ‘other.adp’ is being used to set the -compiler options. - - Move to the error with ‘C-x `’. Ada mode searches the list of -directories given by ‘src_dir’ for the file mentioned in the compiler -error message. - - Fixing the error, linking and running the code proceed as in *note No -project files::. - - -File: ada-mode.info, Node: Use GNAT project file, Next: Use multiple GNAT project files, Prev: Set source search path, Up: Compiling Examples - -6.4 Use GNAT project file -========================= - -In this example, we show how to use a GNAT project file, with no Ada -mode project file. - - Create the directory ‘Example_4’, containing: - - ‘hello_pkg.ads’: - - package Hello_Pkg is - procedure Say_Hello; - end Hello_Pkg; - - ‘hello_pkg.adb’: - - with Ada.Text_IO; - package Hello_Pkg is - procedure Say_Hello - is begin - Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); - end Say_Hello; - end Hello_Pkg; - - These are the same files from example 1; ‘hello_pkg.adb’ has an error -on line 2. - - In addition, create a directory ‘Example_4/Gnat_Project’, containing -these files: - - ‘Gnat_Project/hello_4.adb’: - - with Hello_Pkg; - with Ada.Text_IO; use Ada.Text_IO; - procedure Hello_4 - is begin - Hello_Pkg.Say_Hello; - Put_Line ("From hello_4"); - end Hello_4; - - There are no errors in this file. - - ‘Gnat_Project/hello_4.gpr’: - - Project Hello_4 is - for Source_Dirs use (".", ".."); - end Hello_4; - - In buffer ‘hello_4.adb’, invoke ‘Ada | Project | Load...’, and select -‘Example_4/Gnat_Project/hello_4.gpr’. - - Then, again in ‘hello_4.adb’, invoke ‘Ada | Set main and Build’. You -should get a ‘*compilation*’ buffer containing something like (the -directory paths will be different): - - cd c:/Examples/Example_4/Gnat_Project/ - gnatmake -o hello_4 hello_4 -Phello_4.gpr -cargs -gnatq -gnatQ -bargs -largs - gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\Gnat_Project\hello_4.adb - gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb - hello_pkg.adb:2:08: keyword "body" expected here [see file name] - gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error - - Compare the ‘gcc’ options to the compiler output in *note Set -compiler options::; this shows that ‘hello_4.gpr’ is being used to set -the compiler options. - - Fixing the error, linking and running the code proceed as in *note No -project files::. - - -File: ada-mode.info, Node: Use multiple GNAT project files, Prev: Use GNAT project file, Up: Compiling Examples - -6.5 Use multiple GNAT project files -=================================== - -In this example, we show how to use multiple GNAT project files, -specifying the GNAT project search path in an Ada mode project file. - - Create the directory ‘Example_4’ as specified in *note Use GNAT -project file::. - - Create the directory ‘Example_5’, containing: - - ‘hello_5.adb’: - - with Hello_Pkg; - with Ada.Text_IO; use Ada.Text_IO; - procedure Hello_5 - is begin - Hello_Pkg.Say_Hello; - Put_Line ("From hello_5"); - end Hello_5; - - There are no errors in this file. - - ‘hello_5.adp’: - - ada_project_path=../Example_4/Gnat_Project - gpr_file=hello_5.gpr - - ‘hello_5.gpr’: - - with "hello_4"; - Project Hello_5 is - for Source_Dirs use ("."); - package Compiler is - for Default_Switches ("Ada") use ("-g", "-gnatyt"); - end Compiler; - end Hello_5; - - In buffer ‘hello_5.adb’, invoke ‘Ada | Project | Load...’, and select -‘Example_5/hello_5.adp’. - - Then, again in ‘hello_5.adb’, invoke ‘Ada | Set main and Build’. You -should get a ‘*compilation*’ buffer containing something like (the -directory paths will be different): - - cd c:/Examples/Example_5/ - gnatmake -o hello_5 hello_5 -Phello_5.gpr -g -cargs -gnatq -gnatQ -bargs -largs - gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_5\hello_5.adb - gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb - hello_pkg.adb:2:08: keyword "body" expected here [see file name] - gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error - - Now type ‘C-x `’. ‘Example_4/hello_pkg.adb’ is shown, demonstrating -that ‘hello_5.gpr’ and ‘hello_4.gpr’ are being used to set the -compilation search path. - - -File: ada-mode.info, Node: Moving Through Ada Code, Next: Identifier completion, Prev: Compiling Examples, Up: Top - -7 Moving Through Ada Code -************************* - -There are several easy to use commands to navigate through Ada code. -All these functions are available through the Ada menu, and you can also -use the following key bindings or the command names. Some of these menu -entries are available only if the GNAT compiler is used, since the -implementation relies on the GNAT cross-referencing information. - -‘M-C-e’ - Move to the next function/procedure/task, which ever comes next - (‘ada-next-procedure’). -‘M-C-a’ - Move to previous function/procedure/task - (‘ada-previous-procedure’). -‘M-x ada-next-package’ - Move to next package. -‘M-x ada-previous-package’ - Move to previous package. -‘C-c C-a’ - Move to matching start of ‘end’ (‘ada-move-to-start’). If point is - at the end of a subprogram, this command jumps to the corresponding - ‘begin’ if the user option ‘ada-move-to-declaration’ is ‘nil’ - (default), otherwise it jumps to the subprogram declaration. -‘C-c C-e’ - Move point to end of current block (‘ada-move-to-end’). -‘C-c o’ - Switch between corresponding spec and body file - (‘ff-find-other-file’). If point is in a subprogram, position - point on the corresponding declaration or body in the other file. -‘C-c c-d’ - Move from any reference to its declaration, for from a declaration - to its body (for procedures, tasks, private and incomplete types). -‘C-c C-r’ - Runs the ‘gnatfind’ command to search for all references to the - identifier surrounding point (‘ada-find-references’). Use ‘C-x `’ - (‘next-error’) to visit each reference (as for compilation errors). - - If the ‘ada-xref-create-ali’ variable is non-‘nil’, Emacs will try to -run GNAT for you whenever cross-reference information is needed, and is -older than the current source file. - - -File: ada-mode.info, Node: Identifier completion, Next: Automatic Smart Indentation, Prev: Moving Through Ada Code, Up: Top - -8 Identifier completion -*********************** - -Emacs and Ada mode provide two general ways for the completion of -identifiers. This is an easy way to type faster: you just have to type -the first few letters of an identifiers, and then loop through all the -possible completions. - - The first method is general for Emacs. It works by parsing all open -files for possible completions. - - For instance, if the words ‘my_identifier’, ‘my_subprogram’ are the -only words starting with ‘my’ in any of the opened files, then you will -have this scenario: - - You type: myM-/ - Emacs inserts: ‘my_identifier’ - If you press M-/ once again, Emacs replaces ‘my_identifier’ with - ‘my_subprogram’. - Pressing M-/ once more will bring you back to ‘my_identifier’. - - This is a very fast way to do completion, and the casing of words -will also be respected. - - The second method (‘C-’) is specific to Ada mode and the GNAT -compiler. Emacs will search the cross-information for possible -completions. - - The main advantage is that this completion is more accurate: only -existing identifier will be suggested. - - On the other hand, this completion is a little bit slower and -requires that you have compiled your file at least once since you -created that identifier. - -‘C-’ - Complete current identifier using cross-reference information. -‘M-/’ - Complete identifier using buffer information (not Ada-specific). - - -File: ada-mode.info, Node: Automatic Smart Indentation, Next: Formatting Parameter Lists, Prev: Identifier completion, Up: Top - -9 Automatic Smart Indentation -***************************** - -Ada mode comes with a full set of rules for automatic indentation. You -can also configure the indentation, via the following variables: - -‘ada-broken-indent’ (default value: 2) - Number of columns to indent the continuation of a broken line. - -‘ada-indent’ (default value: 3) - Number of columns for default indentation. - -‘ada-indent-record-rel-type’ (default value: 3) - Indentation for ‘record’ relative to ‘type’ or ‘use’. - -‘ada-indent-return’ (default value: 0) - Indentation for ‘return’ relative to ‘function’ (if - ‘ada-indent-return’ is greater than 0), or the open parenthesis (if - ‘ada-indent-return’ is negative or 0). Note that in the second - case, when there is no open parenthesis, the indentation is done - relative to ‘function’ with the value of ‘ada-broken-indent’. - -‘ada-label-indent’ (default value: -4) - Number of columns to indent a label. - -‘ada-stmt-end-indent’ (default value: 0) - Number of columns to indent a statement ‘end’ keyword on a separate - line. - -‘ada-when-indent’ (default value: 3) - Indentation for ‘when’ relative to ‘exception’ or ‘case’. - -‘ada-indent-is-separate’ (default value: t) - Non-‘nil’ means indent ‘is separate’ or ‘is abstract’ if on a - single line. - -‘ada-indent-to-open-paren’ (default value: t) - Non-‘nil’ means indent according to the innermost open parenthesis. - -‘ada-indent-after-return’ (default value: t) - Non-‘nil’ means that the current line will also be re-indented - before inserting a newline, when you press . - - Most of the time, the indentation will be automatic, i.e., when you -press , the cursor will move to the correct column on the next -line. - - You can also indent single lines, or the current region, with . - - Another mode of indentation exists that helps you to set up your -indentation scheme. If you press ‘C-c ’, Ada mode will do the -following: - - • Reindent the current line, as would do. - • Temporarily move the cursor to a reference line, i.e., the line - that was used to calculate the current indentation. - • Display in the message window the name of the variable that - provided the offset for the indentation. - - The exact indentation of the current line is the same as the one for -the reference line, plus an offset given by the variable. - -‘’ - Indent the current line or the current region. -‘C-M-\’ - Indent lines in the current region. -‘C-c ’ - Indent the current line and display the name of the variable used - for indentation. - - -File: ada-mode.info, Node: Formatting Parameter Lists, Next: Automatic Casing, Prev: Automatic Smart Indentation, Up: Top - -10 Formatting Parameter Lists -***************************** - -‘C-c C-f’ - Format the parameter list (‘ada-format-paramlist’). - - This aligns the declarations on the colon (‘:’) separating argument -names and argument types, and aligns the ‘in’, ‘out’ and ‘in out’ -keywords. - - -File: ada-mode.info, Node: Automatic Casing, Next: Statement Templates, Prev: Formatting Parameter Lists, Up: Top - -11 Automatic Casing -******************* - -Casing of identifiers, attributes and keywords is automatically -performed while typing when the variable ‘ada-auto-case’ is set. Every -time you press a word separator, the previous word is automatically -cased. - - You can customize the automatic casing differently for keywords, -attributes and identifiers. The relevant variables are the following: -‘ada-case-keyword’, ‘ada-case-attribute’ and ‘ada-case-identifier’. - - All these variables can have one of the following values: - -‘downcase-word’ - The word will be lowercase. For instance ‘My_vARIable’ is - converted to ‘my_variable’. - -‘upcase-word’ - The word will be uppercase. For instance ‘My_vARIable’ is - converted to ‘MY_VARIABLE’. - -‘ada-capitalize-word’ - The first letter and each letter following an underscore (‘_’) are - uppercase, others are lowercase. For instance ‘My_vARIable’ is - converted to ‘My_Variable’. - -‘ada-loose-case-word’ - Characters after an underscore ‘_’ character are uppercase, others - are not modified. For instance ‘My_vARIable’ is converted to - ‘My_VARIable’. - - Ada mode allows you to define exceptions to these rules, in a file -specified by the variable ‘ada-case-exception-file’ (default -‘~/.emacs_case_exceptions’). Each line in this file specifies the -casing of one word or word fragment. Comments may be included, -separated from the word by a space. - - If the word starts with an asterisk (‘*’), it defines the casing as a -word fragment (or “substring”); part of a word between two underscores -or word boundary. - - For example: - - DOD Department of Defense - *IO - GNAT The GNAT compiler from Ada Core Technologies - - The word fragment ‘*IO’ applies to any word containing “_io”; -‘Text_IO’, ‘Hardware_IO’, etc. - - There are two ways to add new items to this file: you can simply edit -it as you would edit any text file. Or you can position point on the -word you want to add, and select menu ‘Ada | Edit | Create Case -Exception’, or press ‘C-c C-y’ (‘ada-create-case-exception’). The word -will automatically be added to the current list of exceptions and to the -file. - - To define a word fragment case exception, select the word fragment, -then select menu ‘Ada | Edit | Create Case Exception Substring’. - - It is sometimes useful to have multiple exception files around (for -instance, one could be the standard Ada acronyms, the second some -company specific exceptions, and the last one some project specific -exceptions). If you set up the variable ‘ada-case-exception-file’ as a -list of files, each of them will be parsed and used in your emacs -session. However, when you save a new exception through the menu, as -described above, the new exception will be added to the first file in -the list. - -‘C-c C-b’ - Adjust case in the whole buffer (‘ada-adjust-case-buffer’). -‘C-c C-y’ - Create a new entry in the exception dictionary, with the word under - the cursor (‘ada-create-case-exception’) -‘C-c C-t’ - Rereads the exception dictionary from the file - ‘ada-case-exception-file’ (‘ada-case-read-exceptions’). - - -File: ada-mode.info, Node: Statement Templates, Next: Comment Handling, Prev: Automatic Casing, Up: Top - -12 Statement Templates -********************** - -Templates are defined for most Ada statements, using the Emacs -“skeleton” package. They can be inserted in the buffer using the -following commands: - -‘C-c t b’ - exception Block (‘ada-exception-block’). -‘C-c t c’ - case (‘ada-case’). -‘C-c t d’ - declare Block (‘ada-declare-block’). -‘C-c t e’ - else (‘ada-else’). -‘C-c t f’ - for Loop (‘ada-for-loop’). -‘C-c t h’ - Header (‘ada-header’). -‘C-c t i’ - if (‘ada-if’). -‘C-c t k’ - package Body (‘ada-package-body’). -‘C-c t l’ - loop (‘ada-loop’). -‘C-c p’ - subprogram body (‘ada-subprogram-body’). -‘C-c t t’ - task Body (‘ada-task-body’). -‘C-c t w’ - while Loop (‘ada-while’). -‘C-c t u’ - use (‘ada-use’). -‘C-c t x’ - exit (‘ada-exit’). -‘C-c t C-a’ - array (‘ada-array’). -‘C-c t C-e’ - elsif (‘ada-elsif’). -‘C-c t C-f’ - function Spec (‘ada-function-spec’). -‘C-c t C-k’ - package Spec (‘ada-package-spec’). -‘C-c t C-p’ - procedure Spec (‘ada-package-spec’. -‘C-c t C-r’ - record (‘ada-record’). -‘C-c t C-s’ - subtype (‘ada-subtype’). -‘C-c t C-t’ - task Spec (‘ada-task-spec’). -‘C-c t C-u’ - with (‘ada-with’). -‘C-c t C-v’ - private (‘ada-private’). -‘C-c t C-w’ - when (‘ada-when’). -‘C-c t C-x’ - exception (‘ada-exception’). -‘C-c t C-y’ - type (‘ada-type’). - - -File: ada-mode.info, Node: Comment Handling, Next: GNU Free Documentation License, Prev: Statement Templates, Up: Top - -13 Comment Handling -******************* - -By default, comment lines get indented like Ada code. There are a few -additional functions to handle comments: - -‘M-;’ - Start a comment in default column. -‘M-j’ - Continue comment on next line. -‘C-c ;’ - Comment the selected region (add ‘--’ at the beginning of lines). -‘C-c :’ - Uncomment the selected region -‘M-q’ - autofill the current comment. - - -File: ada-mode.info, Node: GNU Free Documentation License, Next: Index, Prev: Comment Handling, Up: Top - -Appendix A GNU Free Documentation License -***************************************** - - Version 1.3, 3 November 2008 - - Copyright © 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. - - - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - 0. PREAMBLE - - The purpose of this License is to make a manual, textbook, or other - functional and useful document “free” in the sense of freedom: to - assure everyone the effective freedom to copy and redistribute it, - with or without modifying it, either commercially or - noncommercially. Secondarily, this License preserves for the - author and publisher a way to get credit for their work, while not - being considered responsible for modifications made by others. - - This License is a kind of “copyleft”, which means that derivative - works of the document must themselves be free in the same sense. - It complements the GNU General Public License, which is a copyleft - license designed for free software. - - We have designed this License in order to use it for manuals for - free software, because free software needs free documentation: a - free program should come with manuals providing the same freedoms - that the software does. But this License is not limited to - software manuals; it can be used for any textual work, regardless - of subject matter or whether it is published as a printed book. We - recommend this License principally for works whose purpose is - instruction or reference. - - 1. APPLICABILITY AND DEFINITIONS - - This License applies to any manual or other work, in any medium, - that contains a notice placed by the copyright holder saying it can - be distributed under the terms of this License. Such a notice - grants a world-wide, royalty-free license, unlimited in duration, - to use that work under the conditions stated herein. The - “Document”, below, refers to any such manual or work. Any member - of the public is a licensee, and is addressed as “you”. You accept - the license if you copy, modify or distribute the work in a way - requiring permission under copyright law. - - A “Modified Version” of the Document means any work containing the - Document or a portion of it, either copied verbatim, or with - modifications and/or translated into another language. - - A “Secondary Section” is a named appendix or a front-matter section - of the Document that deals exclusively with the relationship of the - publishers or authors of the Document to the Document’s overall - subject (or to related matters) and contains nothing that could - fall directly within that overall subject. (Thus, if the Document - is in part a textbook of mathematics, a Secondary Section may not - explain any mathematics.) The relationship could be a matter of - historical connection with the subject or with related matters, or - of legal, commercial, philosophical, ethical or political position - regarding them. - - The “Invariant Sections” are certain Secondary Sections whose - titles are designated, as being those of Invariant Sections, in the - notice that says that the Document is released under this License. - If a section does not fit the above definition of Secondary then it - is not allowed to be designated as Invariant. The Document may - contain zero Invariant Sections. If the Document does not identify - any Invariant Sections then there are none. - - The “Cover Texts” are certain short passages of text that are - listed, as Front-Cover Texts or Back-Cover Texts, in the notice - that says that the Document is released under this License. A - Front-Cover Text may be at most 5 words, and a Back-Cover Text may - be at most 25 words. - - A “Transparent” copy of the Document means a machine-readable copy, - represented in a format whose specification is available to the - general public, that is suitable for revising the document - straightforwardly with generic text editors or (for images composed - of pixels) generic paint programs or (for drawings) some widely - available drawing editor, and that is suitable for input to text - formatters or for automatic translation to a variety of formats - suitable for input to text formatters. A copy made in an otherwise - Transparent file format whose markup, or absence of markup, has - been arranged to thwart or discourage subsequent modification by - readers is not Transparent. An image format is not Transparent if - used for any substantial amount of text. A copy that is not - “Transparent” is called “Opaque”. - - Examples of suitable formats for Transparent copies include plain - ASCII without markup, Texinfo input format, LaTeX input format, - SGML or XML using a publicly available DTD, and standard-conforming - simple HTML, PostScript or PDF designed for human modification. - Examples of transparent image formats include PNG, XCF and JPG. - Opaque formats include proprietary formats that can be read and - edited only by proprietary word processors, SGML or XML for which - the DTD and/or processing tools are not generally available, and - the machine-generated HTML, PostScript or PDF produced by some word - processors for output purposes only. - - The “Title Page” means, for a printed book, the title page itself, - plus such following pages as are needed to hold, legibly, the - material this License requires to appear in the title page. For - works in formats which do not have any title page as such, “Title - Page” means the text near the most prominent appearance of the - work’s title, preceding the beginning of the body of the text. - - The “publisher” means any person or entity that distributes copies - of the Document to the public. - - A section “Entitled XYZ” means a named subunit of the Document - whose title either is precisely XYZ or contains XYZ in parentheses - following text that translates XYZ in another language. (Here XYZ - stands for a specific section name mentioned below, such as - “Acknowledgements”, “Dedications”, “Endorsements”, or “History”.) - To “Preserve the Title” of such a section when you modify the - Document means that it remains a section “Entitled XYZ” according - to this definition. - - The Document may include Warranty Disclaimers next to the notice - which states that this License applies to the Document. These - Warranty Disclaimers are considered to be included by reference in - this License, but only as regards disclaiming warranties: any other - implication that these Warranty Disclaimers may have is void and - has no effect on the meaning of this License. - - 2. VERBATIM COPYING - - You may copy and distribute the Document in any medium, either - commercially or noncommercially, provided that this License, the - copyright notices, and the license notice saying this License - applies to the Document are reproduced in all copies, and that you - add no other conditions whatsoever to those of this License. You - may not use technical measures to obstruct or control the reading - or further copying of the copies you make or distribute. However, - you may accept compensation in exchange for copies. If you - distribute a large enough number of copies you must also follow the - conditions in section 3. - - You may also lend copies, under the same conditions stated above, - and you may publicly display copies. - - 3. COPYING IN QUANTITY - - If you publish printed copies (or copies in media that commonly - have printed covers) of the Document, numbering more than 100, and - the Document’s license notice requires Cover Texts, you must - enclose the copies in covers that carry, clearly and legibly, all - these Cover Texts: Front-Cover Texts on the front cover, and - Back-Cover Texts on the back cover. Both covers must also clearly - and legibly identify you as the publisher of these copies. The - front cover must present the full title with all words of the title - equally prominent and visible. You may add other material on the - covers in addition. Copying with changes limited to the covers, as - long as they preserve the title of the Document and satisfy these - conditions, can be treated as verbatim copying in other respects. - - If the required texts for either cover are too voluminous to fit - legibly, you should put the first ones listed (as many as fit - reasonably) on the actual cover, and continue the rest onto - adjacent pages. - - If you publish or distribute Opaque copies of the Document - numbering more than 100, you must either include a machine-readable - Transparent copy along with each Opaque copy, or state in or with - each Opaque copy a computer-network location from which the general - network-using public has access to download using public-standard - network protocols a complete Transparent copy of the Document, free - of added material. If you use the latter option, you must take - reasonably prudent steps, when you begin distribution of Opaque - copies in quantity, to ensure that this Transparent copy will - remain thus accessible at the stated location until at least one - year after the last time you distribute an Opaque copy (directly or - through your agents or retailers) of that edition to the public. - - It is requested, but not required, that you contact the authors of - the Document well before redistributing any large number of copies, - to give them a chance to provide you with an updated version of the - Document. - - 4. MODIFICATIONS - - You may copy and distribute a Modified Version of the Document - under the conditions of sections 2 and 3 above, provided that you - release the Modified Version under precisely this License, with the - Modified Version filling the role of the Document, thus licensing - distribution and modification of the Modified Version to whoever - possesses a copy of it. In addition, you must do these things in - the Modified Version: - - A. Use in the Title Page (and on the covers, if any) a title - distinct from that of the Document, and from those of previous - versions (which should, if there were any, be listed in the - History section of the Document). You may use the same title - as a previous version if the original publisher of that - version gives permission. - - B. List on the Title Page, as authors, one or more persons or - entities responsible for authorship of the modifications in - the Modified Version, together with at least five of the - principal authors of the Document (all of its principal - authors, if it has fewer than five), unless they release you - from this requirement. - - C. State on the Title page the name of the publisher of the - Modified Version, as the publisher. - - D. Preserve all the copyright notices of the Document. - - E. Add an appropriate copyright notice for your modifications - adjacent to the other copyright notices. - - F. Include, immediately after the copyright notices, a license - notice giving the public permission to use the Modified - Version under the terms of this License, in the form shown in - the Addendum below. - - G. Preserve in that license notice the full lists of Invariant - Sections and required Cover Texts given in the Document’s - license notice. - - H. Include an unaltered copy of this License. - - I. Preserve the section Entitled “History”, Preserve its Title, - and add to it an item stating at least the title, year, new - authors, and publisher of the Modified Version as given on the - Title Page. If there is no section Entitled “History” in the - Document, create one stating the title, year, authors, and - publisher of the Document as given on its Title Page, then add - an item describing the Modified Version as stated in the - previous sentence. - - J. Preserve the network location, if any, given in the Document - for public access to a Transparent copy of the Document, and - likewise the network locations given in the Document for - previous versions it was based on. These may be placed in the - “History” section. You may omit a network location for a work - that was published at least four years before the Document - itself, or if the original publisher of the version it refers - to gives permission. - - K. For any section Entitled “Acknowledgements” or “Dedications”, - Preserve the Title of the section, and preserve in the section - all the substance and tone of each of the contributor - acknowledgements and/or dedications given therein. - - L. Preserve all the Invariant Sections of the Document, unaltered - in their text and in their titles. Section numbers or the - equivalent are not considered part of the section titles. - - M. Delete any section Entitled “Endorsements”. Such a section - may not be included in the Modified Version. - - N. Do not retitle any existing section to be Entitled - “Endorsements” or to conflict in title with any Invariant - Section. - - O. Preserve any Warranty Disclaimers. - - If the Modified Version includes new front-matter sections or - appendices that qualify as Secondary Sections and contain no - material copied from the Document, you may at your option designate - some or all of these sections as invariant. To do this, add their - titles to the list of Invariant Sections in the Modified Version’s - license notice. These titles must be distinct from any other - section titles. - - You may add a section Entitled “Endorsements”, provided it contains - nothing but endorsements of your Modified Version by various - parties—for example, statements of peer review or that the text has - been approved by an organization as the authoritative definition of - a standard. - - You may add a passage of up to five words as a Front-Cover Text, - and a passage of up to 25 words as a Back-Cover Text, to the end of - the list of Cover Texts in the Modified Version. Only one passage - of Front-Cover Text and one of Back-Cover Text may be added by (or - through arrangements made by) any one entity. If the Document - already includes a cover text for the same cover, previously added - by you or by arrangement made by the same entity you are acting on - behalf of, you may not add another; but you may replace the old - one, on explicit permission from the previous publisher that added - the old one. - - The author(s) and publisher(s) of the Document do not by this - License give permission to use their names for publicity for or to - assert or imply endorsement of any Modified Version. - - 5. COMBINING DOCUMENTS - - You may combine the Document with other documents released under - this License, under the terms defined in section 4 above for - modified versions, provided that you include in the combination all - of the Invariant Sections of all of the original documents, - unmodified, and list them all as Invariant Sections of your - combined work in its license notice, and that you preserve all - their Warranty Disclaimers. - - The combined work need only contain one copy of this License, and - multiple identical Invariant Sections may be replaced with a single - copy. If there are multiple Invariant Sections with the same name - but different contents, make the title of each such section unique - by adding at the end of it, in parentheses, the name of the - original author or publisher of that section if known, or else a - unique number. Make the same adjustment to the section titles in - the list of Invariant Sections in the license notice of the - combined work. - - In the combination, you must combine any sections Entitled - “History” in the various original documents, forming one section - Entitled “History”; likewise combine any sections Entitled - “Acknowledgements”, and any sections Entitled “Dedications”. You - must delete all sections Entitled “Endorsements.” - - 6. COLLECTIONS OF DOCUMENTS - - You may make a collection consisting of the Document and other - documents released under this License, and replace the individual - copies of this License in the various documents with a single copy - that is included in the collection, provided that you follow the - rules of this License for verbatim copying of each of the documents - in all other respects. - - You may extract a single document from such a collection, and - distribute it individually under this License, provided you insert - a copy of this License into the extracted document, and follow this - License in all other respects regarding verbatim copying of that - document. - - 7. AGGREGATION WITH INDEPENDENT WORKS - - A compilation of the Document or its derivatives with other - separate and independent documents or works, in or on a volume of a - storage or distribution medium, is called an “aggregate” if the - copyright resulting from the compilation is not used to limit the - legal rights of the compilation’s users beyond what the individual - works permit. When the Document is included in an aggregate, this - License does not apply to the other works in the aggregate which - are not themselves derivative works of the Document. - - If the Cover Text requirement of section 3 is applicable to these - copies of the Document, then if the Document is less than one half - of the entire aggregate, the Document’s Cover Texts may be placed - on covers that bracket the Document within the aggregate, or the - electronic equivalent of covers if the Document is in electronic - form. Otherwise they must appear on printed covers that bracket - the whole aggregate. - - 8. TRANSLATION - - Translation is considered a kind of modification, so you may - distribute translations of the Document under the terms of section - 4. Replacing Invariant Sections with translations requires special - permission from their copyright holders, but you may include - translations of some or all Invariant Sections in addition to the - original versions of these Invariant Sections. You may include a - translation of this License, and all the license notices in the - Document, and any Warranty Disclaimers, provided that you also - include the original English version of this License and the - original versions of those notices and disclaimers. In case of a - disagreement between the translation and the original version of - this License or a notice or disclaimer, the original version will - prevail. - - If a section in the Document is Entitled “Acknowledgements”, - “Dedications”, or “History”, the requirement (section 4) to - Preserve its Title (section 1) will typically require changing the - actual title. - - 9. TERMINATION - - You may not copy, modify, sublicense, or distribute the Document - except as expressly provided under this License. Any attempt - otherwise to copy, modify, sublicense, or distribute it is void, - and will automatically terminate your rights under this License. - - However, if you cease all violation of this License, then your - license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly and - finally terminates your license, and (b) permanently, if the - copyright holder fails to notify you of the violation by some - reasonable means prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is - reinstated permanently if the copyright holder notifies you of the - violation by some reasonable means, this is the first time you have - received notice of violation of this License (for any work) from - that copyright holder, and you cure the violation prior to 30 days - after your receipt of the notice. - - Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from you - under this License. If your rights have been terminated and not - permanently reinstated, receipt of a copy of some or all of the - same material does not give you any rights to use it. - - 10. FUTURE REVISIONS OF THIS LICENSE - - The Free Software Foundation may publish new, revised versions of - the GNU Free Documentation License from time to time. Such new - versions will be similar in spirit to the present version, but may - differ in detail to address new problems or concerns. See - . - - Each version of the License is given a distinguishing version - number. If the Document specifies that a particular numbered - version of this License “or any later version” applies to it, you - have the option of following the terms and conditions either of - that specified version or of any later version that has been - published (not as a draft) by the Free Software Foundation. If the - Document does not specify a version number of this License, you may - choose any version ever published (not as a draft) by the Free - Software Foundation. If the Document specifies that a proxy can - decide which future versions of this License can be used, that - proxy’s public statement of acceptance of a version permanently - authorizes you to choose that version for the Document. - - 11. RELICENSING - - “Massive Multiauthor Collaboration Site” (or “MMC Site”) means any - World Wide Web server that publishes copyrightable works and also - provides prominent facilities for anybody to edit those works. A - public wiki that anybody can edit is an example of such a server. - A “Massive Multiauthor Collaboration” (or “MMC”) contained in the - site means any set of copyrightable works thus published on the MMC - site. - - “CC-BY-SA” means the Creative Commons Attribution-Share Alike 3.0 - license published by Creative Commons Corporation, a not-for-profit - corporation with a principal place of business in San Francisco, - California, as well as future copyleft versions of that license - published by that same organization. - - “Incorporate” means to publish or republish a Document, in whole or - in part, as part of another Document. - - An MMC is “eligible for relicensing” if it is licensed under this - License, and if all works that were first published under this - License somewhere other than this MMC, and subsequently - incorporated in whole or in part into the MMC, (1) had no cover - texts or invariant sections, and (2) were thus incorporated prior - to November 1, 2008. - - The operator of an MMC Site may republish an MMC contained in the - site under CC-BY-SA on the same site at any time before August 1, - 2009, provided the MMC is eligible for relicensing. - -ADDENDUM: How to use this License for your documents -==================================================== - -To use this License in a document you have written, include a copy of -the License in the document and put the following copyright and license -notices just after the title page: - - Copyright (C) YEAR YOUR NAME. - Permission is granted to copy, distribute and/or modify this document - under the terms of the GNU Free Documentation License, Version 1.3 - or any later version published by the Free Software Foundation; - with no Invariant Sections, no Front-Cover Texts, and no Back-Cover - Texts. A copy of the license is included in the section entitled ``GNU - Free Documentation License''. - - If you have Invariant Sections, Front-Cover Texts and Back-Cover -Texts, replace the “with...Texts.” line with this: - - with the Invariant Sections being LIST THEIR TITLES, with - the Front-Cover Texts being LIST, and with the Back-Cover Texts - being LIST. - - If you have Invariant Sections without Cover Texts, or some other -combination of the three, merge those two alternatives to suit the -situation. - - If your document contains nontrivial examples of program code, we -recommend releasing these examples in parallel under your choice of free -software license, such as the GNU General Public License, to permit -their use in free software. - - -File: ada-mode.info, Node: Index, Prev: GNU Free Documentation License, Up: Top - -Index -***** - -[index] -* Menu: - -* ada-adjust-case-buffer: Automatic Casing. (line 74) -* ada-array: Statement Templates. (line 39) -* ada-case: Statement Templates. (line 13) -* ada-case-read-exceptions: Automatic Casing. (line 79) -* ada-complete-identifier: Identifier completion. - (line 39) -* ada-create-case-exception: Automatic Casing. (line 54) -* ada-declare-block: Statement Templates. (line 15) -* ada-else: Statement Templates. (line 17) -* ada-elsif: Statement Templates. (line 41) -* ada-exception: Statement Templates. (line 61) -* ada-exception-block: Statement Templates. (line 11) -* ada-exit: Statement Templates. (line 37) -* ada-find-references: Moving Through Ada Code. - (line 37) -* ada-for-loop: Statement Templates. (line 19) -* ada-format-paramlist: Formatting Parameter Lists. - (line 7) -* ada-function-spec: Statement Templates. (line 43) -* ada-goto-declaration: Moving Through Ada Code. - (line 34) -* ada-header: Statement Templates. (line 21) -* ada-if: Statement Templates. (line 23) -* ada-loop: Statement Templates. (line 27) -* ada-move-to-end: Moving Through Ada Code. - (line 28) -* ada-move-to-start: Moving Through Ada Code. - (line 23) -* ada-next-package: Moving Through Ada Code. - (line 19) -* ada-next-procedure: Moving Through Ada Code. - (line 13) -* ada-package-body: Statement Templates. (line 25) -* ada-package-spec: Statement Templates. (line 45) -* ada-previous-package: Moving Through Ada Code. - (line 21) -* ada-previous-procedure: Moving Through Ada Code. - (line 16) -* ada-private: Statement Templates. (line 57) -* ada-procedure-spec: Statement Templates. (line 47) -* ada-record: Statement Templates. (line 49) -* ada-subprogram-body: Statement Templates. (line 29) -* ada-subtype: Statement Templates. (line 51) -* ada-task-body: Statement Templates. (line 31) -* ada-task-spec: Statement Templates. (line 53) -* ada-type: Statement Templates. (line 63) -* ada-use: Statement Templates. (line 35) -* ada-when: Statement Templates. (line 59) -* ada-while: Statement Templates. (line 33) -* ada-with: Statement Templates. (line 55) - - - -Tag Table: -Node: Top862 -Node: Overview2536 -Node: Installation3858 -Node: Customization5019 -Node: Non-standard file names5943 -Node: Other compiler7474 -Node: Other customization7978 -Node: Compiling Executing8652 -Node: Compile commands9328 -Node: Compiler errors12177 -Node: Project files13082 -Node: Project File Overview13795 -Node: GUI Editor16150 -Node: Project file variables16642 -Node: Compiling Examples23982 -Node: No project files24780 -Node: Set compiler options29651 -Node: Set source search path31696 -Node: Use GNAT project file34044 -Node: Use multiple GNAT project files36288 -Node: Moving Through Ada Code38239 -Node: Identifier completion40280 -Node: Automatic Smart Indentation41884 -Node: Formatting Parameter Lists44754 -Node: Automatic Casing45184 -Node: Statement Templates48588 -Node: Comment Handling50251 -Node: GNU Free Documentation License50806 -Node: Index76164 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/old_ada/doc/ada-mode.pdf b/old_ada/doc/ada-mode.pdf deleted file mode 100644 index c3f3839..0000000 Binary files a/old_ada/doc/ada-mode.pdf and /dev/null differ diff --git a/old_ada/doc/ada-mode.texi b/old_ada/doc/ada-mode.texi deleted file mode 100644 index 1ac90cd..0000000 --- a/old_ada/doc/ada-mode.texi +++ /dev/null @@ -1,1526 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@setfilename ../../info/ada-mode.info -@settitle Ada Mode -@include docstyle.texi - -@copying -Copyright @copyright{} 1999--2019 Free Software Foundation, Inc. - -@quotation -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with no -Invariant Sections, with the Front-Cover Texts being ``A GNU Manual'', -and with the Back-Cover Texts as in (a) below. A copy of the license -is included in the section entitled ``GNU Free Documentation License''. - -(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and -modify this GNU manual.'' -@end quotation -@end copying - -@dircategory Emacs editing modes -@direntry -* Ada mode: (ada-mode). Emacs mode for editing and compiling Ada code. -@end direntry - -@titlepage -@sp 10 -@title Ada Mode -@sp 2 -@subtitle An Emacs major mode for programming in Ada -@subtitle Ada Mode Version 4.00 -@sp 2 -@page -@vskip 0pt plus 1filll -@insertcopying -@end titlepage - -@contents - -@node Top -@top Ada Mode - -@ifnottex -@insertcopying -@end ifnottex - -@menu -* Overview:: -* Installation:: Installing Ada mode on your system -* Customization:: Setting up Ada mode to your taste -* Compiling Executing:: Working with your application within Emacs -* Project files:: Describing the organization of your project -* Compiling Examples:: A small tutorial -* Moving Through Ada Code:: Moving easily through Ada sources -* Identifier completion:: Finishing words automatically -* Automatic Smart Indentation:: Indenting your code automatically as you type -* Formatting Parameter Lists:: Formatting subprograms' parameter lists - automatically -* Automatic Casing:: Adjusting the case of words automatically -* Statement Templates:: Inserting code templates -* Comment Handling:: Reformatting comments easily -* GNU Free Documentation License:: The license for this documentation. -* Index:: -@end menu - - -@node Overview -@chapter Overview - -The Emacs mode for programming in Ada helps the user in understanding -existing code and facilitates writing new code. - -When the GNU Ada compiler GNAT is used, the cross-reference -information output by the compiler is used to provide powerful code -navigation (jump to definition, find all uses, etc.). - -When you open a file with a file extension of @file{.ads} or -@file{.adb}, Emacs will automatically load and activate Ada mode. - -Ada mode works without any customization, if you are using the GNAT -compiler (@url{https://libre2.adacore.com/}) and the GNAT default -naming convention. - -You must customize a few things if you are using a different compiler -or file naming convention; @xref{Other compiler}, @xref{Non-standard -file names}. - -In addition, you may want to customize the indentation, -capitalization, and other things; @xref{Other customization}. - -Finally, for large Ada projects, you will want to set up an Emacs -Ada mode project file for each project; @xref{Project files}. Note -that these are different from the GNAT project files used by gnatmake -and other GNAT commands. - -See the Emacs info manual, section 'Running Debuggers Under Emacs', -for general information on debugging. - -@node Installation -@chapter Installation - -Ada mode is part of the standard Emacs distribution; if you use that, -no files need to be installed. - -Ada mode is also available as a separate distribution, from the Emacs -Ada mode website -@uref{http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html}. The -separate distribution may be more recent. - -For installing the separate distribution, see the @file{README} file -in the distribution. - -To see what version of Ada mode you have installed, do @kbd{M-x -ada-mode-version}. - -The following files are provided with the Ada mode distribution: - -@itemize @bullet - -@item -@file{ada-mode.el}: The main file for Ada mode, providing indentation, -formatting of parameter lists, moving through code, comment handling -and automatic casing. - -@item -@file{ada-prj.el}: GUI editing of Ada mode project files, using Emacs -widgets. - -@item -@file{ada-stmt.el}: Ada statement templates. - -@item -@file{ada-xref.el}: GNAT cross-references, completion of identifiers, -and compilation. Also provides project files (which are not -GNAT-specific). - -@end itemize - -@node Customization -@chapter Customizing Ada mode - -Here we assume you are familiar with setting variables in Emacs, -either thru 'customize' or in elisp (in your @file{.emacs} file). For -a basic introduction to customize, elisp, and Emacs in general, see -the tutorial in -@iftex -@cite{The GNU Emacs Manual}. -@end iftex -@ifhtml -@cite{The GNU Emacs Manual}. -@end ifhtml -@ifinfo -@ref{Top, , The GNU Emacs Manual, emacs, The GNU Emacs Manual}. -@end ifinfo - -These global Emacs settings are strongly recommended (put them in your -.emacs): - -@example -(global-font-lock-mode t) -(transient-mark-mode t) -@end example - -@samp{(global-font-lock-mode t)} turns on syntax -highlighting for all buffers (it is off by default because it may be -too slow for some machines). - -@samp{(transient-mark-mode t)} highlights selected text. - -See the Emacs help for each of these variables for more information. - -@menu -* Non-standard file names:: -* Other compiler:: -* Other customization:: -@end menu - -@node Non-standard file names -@section Non-standard file names - -By default, Ada mode is configured to use the GNAT file naming -convention, where file names are a simple modification of the Ada -names, and the extension for specs and bodies are -@samp{.ads} and @samp{.adb}, respectively. - -Ada mode uses the file extensions to allow moving from a package body -to the corresponding spec and back. - -Ada mode supports a list of alternative file extensions for specs and bodies. - -For instance, if your spec and bodies files are called -@file{@var{unit}_s.ada} and @file{@var{unit}_b.ada}, respectively, you -can add the following to your @file{.emacs} file: - -@example -(ada-add-extensions "_s.ada" "_b.ada") -@end example - -You can define additional extensions: - -@example -(ada-add-extensions ".ads" "_b.ada") -(ada-add-extensions ".ads" ".body") -@end example - -This means that whenever Ada mode looks for the body for a file -whose extension is @file{.ads}, it will take the first available file -that ends with either @file{.adb}, @file{_b.ada} or -@file{.body}. - -Similarly, if Ada mode is looking for a spec, it will look for -@file{.ads} or @file{_s.ada}. - -If the filename is not derived from the Ada name following the GNAT -convention, things are a little more complicated. You then need to -rewrite the function @code{ada-make-filename-from-adaname}. Doing that -is beyond the scope of this manual; see the current definitions in -@file{ada-mode.el} and @file{ada-xref.el} for examples. - -@node Other compiler -@section Other compiler - -By default, Ada mode is configured to use the GNU Ada compiler GNAT. - -To use a different Ada compiler, you must specify the command lines -used to run that compiler, either in lisp variables or in Emacs -Ada mode project files. See @ref{Project file variables} for the list -of project variables, and the corresponding lisp variables. - -@node Other customization -@section Other customization - -All user-settable Ada mode variables can be set via the menu -@samp{Ada | Customize}. Click on the @samp{Help} button there for help -on using customize. - -To modify a specific variable, you can directly call the function -@code{customize-variable}; just type @kbd{M-x customize-variable -@key{RET} @var{variable-name} @key{RET}}). - -Alternately, you can specify variable settings in the Emacs -configuration file, @file{.emacs}. This file is coded in Emacs lisp, -and the syntax to set a variable is the following: -@example -(setq variable-name value) -@end example - -@node Compiling Executing -@chapter Compiling Executing - -Ada projects can be compiled, linked, and executed using commands on -the Ada menu. All of these commands can be customized via a project -file (@pxref{Project files}), but the defaults are sufficient for using -the GNAT compiler for simple projects (single files, or several files -in a single directory). - -Even when no project file is used, the GUI project editor (menu -@samp{Ada | Project | Edit}) shows the settings of the various project -file variables referenced here. - -@menu -* Compile commands:: -* Compiler errors:: -@end menu - -@node Compile commands -@section Compile commands - -Here are the commands for building and using an Ada project, as -listed in the Ada menu. - -In multi-file projects, there must be one file that is the main -program. That is given by the @code{main} project file variable; -it defaults to the current file if not yet set, but is also set by the -``set main and build'' command. - -@table @code - -@item Check file -Compiles the current file in syntax check mode, by running -@code{check_cmd} defined in the current project file. This typically -runs faster than full compile mode, speeding up finding and fixing -compilation errors. - -This sets @code{main} only if it has not been set yet. - -@item Compile file -Compiles the current file, by running @code{comp_cmd} from the current -project file. - -This does not set @code{main}. - -@item Set main and Build -Sets @code{main} to the current file, then executes the Build -command. - -@item Show main -Display @code{main} in the message buffer. - -@item Build -Compiles all obsolete units of the current @code{main}, and links -@code{main}, by running @code{make_cmd} from the current project. - -This sets @code{main} only if it has not been set yet. - -@item Run -Executes the main program in a shell, displayed in a separate Emacs -buffer. This runs @code{run_cmd} from the current project. The -execution buffer allows for interactive input/output. - -To modify the run command, in particular to provide or change the -command line arguments, type @kbd{C-u} before invoking the command. - -This command is not available for a cross-compilation toolchain. - -@end table -It is important when using these commands to understand how -@code{main} is used and changed. - -Build runs 'gnatmake' on the main unit. During a typical edit/compile -session, this is the only command you need to invoke, which is why it -is bound to @kbd{C-c C-c}. It will compile all files needed by the -main unit, and display compilation errors in any of them. - -Note that Build can be invoked from any Ada buffer; typically you will -be fixing errors in files other than the main, but you don't have to -switch back to the main to invoke the compiler again. - -Novices and students typically work on single-file Ada projects. In -this case, @kbd{C-c C-m} will normally be the only command needed; it -will build the current file, rather than the last-built main. - -There are three ways to change @code{main}: - -@enumerate -@item -Invoke @samp{Ada | Set main and Build}, which sets @code{main} to -the current file. - -@item -Invoke @samp{Ada | Project | Edit}, edit @code{main} and -@code{main}, and click @samp{[save]} - -@item -Invoke @samp{Ada | Project | Load}, and load a project file that specifies @code{main} - -@end enumerate - -@node Compiler errors -@section Compiler errors - -The @code{Check file}, @code{Compile file}, and @code{Build} commands -all place compilation errors in a separate buffer named -@file{*compilation*}. - -Each line in this buffer will become active: you can simply click on -it with the middle button of the mouse, or move point to it and press -@key{RET}. Emacs will then display the relevant source file and put -point on the line and column where the error was found. - -You can also press the @kbd{C-x `} key (@code{next-error}), and Emacs -will jump to the first error. If you press that key again, it will -move you to the second error, and so on. - -Some error messages might also include references to other files. These -references are also clickable in the same way, or put point after the -line number and press @key{RET}. - -@node Project files -@chapter Project files - -An Emacs Ada mode project file specifies what directories hold sources -for your project, and allows you to customize the compilation commands -and other things on a per-project basis. - -Note that Ada mode project files @file{*.adp} are different than GNAT -compiler project files @file{*.gpr}. However, Emacs Ada mode can use a -GNAT project file to specify the project directories. If no -other customization is needed, a GNAT project file can be used without -an Emacs Ada mode project file. - -@menu -* Project File Overview:: -* GUI Editor:: -* Project file variables:: -@end menu - -@node Project File Overview -@section Project File Overview - -Project files have a simple syntax; they may be edited directly. Each -line specifies a project variable name and its value, separated by ``='': -@example -src_dir=/Projects/my_project/src_1 -src_dir=/Projects/my_project/src_2 -@end example - -Some variables (like @code{src_dir}) are lists; multiple occurrences -are concatenated. - -There must be no space between the variable name and ``='', and no -trailing spaces. - -Alternately, a GUI editor for project files is available (@pxref{GUI -Editor}). It uses Emacs widgets, similar to Emacs customize. - -The GUI editor also provides a convenient way to view current project -settings, if they have been modified using menu commands rather than -by editing the project file. - -After the first Ada mode build command is invoked, there is always a -current project file, given by the lisp variable -@code{ada-prj-default-project-file}. Currently, the only way to show -the current project file is to invoke the GUI editor. - -To find the project file the first time, Ada mode uses the following -search algorithm: - -@itemize @bullet -@item -If @code{ada-prj-default-project-file} is set, use that. - -@item -Otherwise, search for a file in the current directory with -the same base name as the Ada file, but extension given by -@code{ada-prj-file-extension} (default @code{".adp"}). - -@item -If not found, search for @file{*.adp} in the current directory; if -several are found, prompt the user to select one. - -@item -If none are found, use @file{default.adp} in the current directory (even -if it does not exist). - -@end itemize - -This algorithm always sets @code{ada-prj-default-project-file}, even -when the file does not actually exist. - -To change the project file before or after the first one is found, -invoke @samp{Ada | Project | Load ...}. - -Or, in lisp, evaluate @code{(ada-set-default-project-file "/path/file.adp")}. -This sets @code{ada-prj-default-project-file}, and reads the project file. - -You can also specify a GNAT project file to @samp{Ada | Project | Load -...} or @code{ada-set-default-project-file}. Emacs Ada mode checks the -file extension; if it is @code{.gpr}, the file is treated as a GNAT -project file. Any other extension is treated as an Emacs Ada mode -project file. - -@node GUI Editor -@section GUI Editor - -The project file editor is invoked with the menu @samp{Ada | Projects -| Edit}. - -Once in the buffer for editing the project file, you can save your -modification using the @samp{[save]} button at the bottom of the -buffer, or the @kbd{C-x C-s} binding. To cancel your modifications, -kill the buffer or click on the @samp{[cancel]} button. - -@node Project file variables -@section Project file variables - -The following variables can be defined in a project file; some can -also be defined in lisp variables. - -To set a project variable that is a list, specify each element of the -list on a separate line in the project file. - -Any project variable can be referenced in other project variables, -using a shell-like notation. For instance, if the variable -@code{comp_cmd} contains @code{$@{comp_opt@}}, the value of the -@code{comp_opt} variable will be substituted when @code{comp_cmd} is -used. - -In addition, process environment variables can be referenced using the -same syntax, or the normal @code{$var} syntax. - -Most project variables have defaults that can be changed by setting -lisp variables; the table below identifies the lisp variable for each -project variable. Lisp variables corresponding to project variables -that are lists are lisp lists. - -In general, project variables are evaluated when referenced in -Emacs Ada mode commands. Relative file paths are expanded to -absolute relative to @code{$@{build_dir@}}. - -Here is the list of variables. In the default values, the current -directory @code{"."} is the project file directory. - -@table @asis -@c defined in ada-default-prj-properties; alphabetical order - -@item @code{ada_project_path_sep} [default: @code{":" or ";"}] -Path separator for @code{ADA_PROJECT_PATH}. It defaults to the correct -value for a native implementation of GNAT for the current operating -system. The user must override this when using Windows native GNAT -with Cygwin Emacs, and perhaps in other cases. - -Lisp variable: @code{ada-prj-ada-project-path-sep}. - -@item @code{ada_project_path} [default: @code{""}] -A list of directories to search for GNAT project files. - -If set, the @code{ADA_PROJECT_PATH} process environment variable is -set to this value in the Emacs process when the Emacs Ada mode project -is selected via menu @samp{Ada | Project | Load}. - -For @code{ada_project_path}, relative file paths are expanded to -absolute when the Emacs Ada project file is read, rather than when the -project file is selected. - -For example if the project file is in the directory -@file{/home/myproject}, the environment variable @code{GDS_ROOT} is -set to @code{/home/shared}, and the project file contains: -@example -ada_project_path_sep=: -ada_project_path=$GDS_ROOT/makerules -ada_project_path=../opentoken -@end example -then as a result the environment variable @code{ADA_PROJECT_PATH} will -be set to @code{"/home/shared/makerules:/home/opentoken/"}. - -The default value is not the current value of this environment -variable, because that will typically have been set by another -project, and will therefore be incorrect for this project. - -If you have the environment variable set correctly for all of your -projects, you do not need to set this project variable. - -@item @code{bind_opt} [default: @code{""}] -Holds user binder options; used in the default build commands. - -Lisp variable: @code{ada-prj-default-bind-opt}. - -@item @code{build_dir} [default: @code{"."}] -The compile commands will be issued in this directory. - -@item @code{casing} [default: @code{("~/.emacs_case_exceptions")}] -List of files containing casing exceptions. See the help on -@code{ada-case-exception-file} for more info. -@c FIXME: section on case exceptions - -Lisp variable: @code{ada-case-exception-file}. - -@item @code{check_cmd} [default: @code{"$@{cross_prefix@}gnatmake -u -c -gnatc $@{gnatmake_opt@} $@{full_current@} -cargs $@{comp_opt@}"}] -Command used to syntax check a single file. -The name of the file is substituted for @code{full_current}. - -Lisp variable: @code{ada-prj-default-check-cmd} - -@item @code{comp_cmd} [default: @code{"$@{cross_prefix@}gnatmake -u -c $@{gnatmake_opt@} $@{full_current@} -cargs $@{comp_opt@}"}] -Command used to compile a single file. -The name of the file is substituted for @code{full_current}. - -Lisp variable: @code{ada-prj-default-comp-cmd}. - -@item @code{comp_opt} [default: @code{"-gnatq -gnatQ"}] -Holds user compiler options; used in the default compile commands. The -default value tells gnatmake to generate library files for -cross-referencing even when there are errors. - -If source code for the project is in multiple directories, the -appropriate compiler options must be added here. @ref{Set source -search path} for examples of this. Alternately, GNAT project files may -be used; @ref{Use GNAT project file}. - -Lisp variable: @code{ada-prj-default-comp-opt}. - -@item @code{cross_prefix} [default: @code{""}] -Name of target machine in a cross-compilation environment. Used in -default compile and build commands. - -@item @code{debug_cmd} [default: @code{"$@{cross_prefix@}gdb $@{main@}"}] -Command used to debug the application - -Lisp variable: @code{ada-prj-default-debugger}. - -@item @code{debug_post_cmd} [default: @code{""}] -Command executed after @code{debug_cmd}. - -@item @code{debug_pre_cmd} [default: @code{"cd $@{build_dir@}"}] -Command executed before @code{debug_cmd}. - -@item @code{gnatfind_opt} [default: @code{"-rf"}] -Holds user gnatfind options; used in the default find commands. - -Lisp variable: @code{ada-prj-gnatfind-switches}. - -@item @code{gnatmake_opt} [default: @code{"-g"}] -Holds user gnatmake options; used in the default build commands. - -Lisp variable: @code{ada-prj-default-gnatmake-opt}. - -@item @code{gpr_file} [default: @code{""}] -Specify GNAT project file. - -If set, the source and object directories specified in the GNAT -project file are appended to @code{src_dir} and @code{obj_dir}. This -allows specifying Ada source directories with a GNAT project file, and -other source directories with the Emacs project file. - -In addition, @code{-P@{gpr_file@}} is added to the project variable -@code{gnatmake_opt} whenever it is referenced. With the default -project variables, this passes the project file to all gnatmake -commands. - -Lisp variable: @code{ada-prj-default-gpr-file}. - -@c FIXME: add gnatstub-opts - -@item @code{link_opt} [default: @code{""}] -Holds user linker options; used in the default build commands. - -Lisp variable: @code{ada-prj-default-link-opt}. - -@item @code{main} [default: current file] -Specifies the name of the executable file for the project; used in the -default build commands. - -@item @code{make_cmd} [default: @code{"$@{cross_prefix@}gnatmake -o $@{main@} $@{main@} $@{gnatmake_opt@} -cargs $@{comp_opt@} -bargs $@{bind_opt@} -largs $@{link_opt@}"}] -Command used to build the application. - -Lisp variable: @code{ada-prj-default-make-cmd}. - -@item @code{obj_dir} [default: @code{"."}] -A list of directories to search for library files. Ada mode searches -this list for the @samp{.ali} files generated by GNAT that contain -cross-reference information. - -The compiler commands must place the @samp{.ali} files in one of these -directories; the default commands do that. - -@item @code{remote_machine} [default: @code{""}] -Name of the machine to log into before issuing the compile and build -commands. If this variable is empty, the command will be run on the -local machine. - -@item @code{run_cmd} [default: @code{"./$@{main@}"}] -Command used to run the application. - -@item @code{src_dir} [default: @code{"."}] -A list of directories to search for source files, both for compile -commands and source navigation. - -@end table - -@node Compiling Examples -@chapter Compiling Examples - -We present several small projects, and walk thru the process of -compiling, linking, and running them. - -The first example illustrates more Ada mode features than the others; -you should work thru that example before doing the others. - -All of these examples assume you are using GNAT. - -The source for these examples is available on the Emacs Ada mode -website mentioned in @xref{Installation}. - -@menu -* No project files:: Just menus -* Set compiler options:: A basic Ada mode project file -* Set source search path:: Source in multiple directories -* Use GNAT project file:: -* Use multiple GNAT project files:: -@end menu - -@node No project files -@section No project files -This example uses no project files. - -First, create a directory @file{Example_1}, containing: - -@file{hello.adb}: - -@example -with Ada.Text_IO; -procedure Hello -is begin - Put_Line("Hello from hello.adb"); -end Hello; -@end example - -Yes, this is missing ``use Ada.Text_IO;'' - we want to demonstrate -compiler error handling. - -@file{hello_2.adb}: - -@example -with Hello_Pkg; -procedure Hello_2 -is begin - Hello_Pkg.Say_Hello; -end Hello_2; -@end example - -This file has no errors. - -@file{hello_pkg.ads}: - -@example -package Hello_Pkg is - procedure Say_Hello; -end Hello_Pkg; -@end example - -This file has no errors. - -@file{hello_pkg.adb}: - -@example -with Ada.Text_IO; -package Hello_Pkg is - procedure Say_Hello - is begin - Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); - end Say_Hello; -end Hello_Pkg; -@end example - -Yes, this is missing the keyword @code{body}; another compiler error -example. - -In buffer @file{hello.adb}, invoke @samp{Ada | Check file}. You should -get a @file{*compilation*} buffer containing something like (the -directory paths will be different): - -@smallexample -cd c:/Examples/Example_1/ -gnatmake -u -c -gnatc -g c:/Examples/Example_1/hello.adb -cargs -gnatq -gnatQ -gcc -c -Ic:/Examples/Example_1/ -gnatc -g -gnatq -gnatQ -I- c:/Examples/Example_1/hello.adb -hello.adb:4:04: "Put_Line" is not visible -hello.adb:4:04: non-visible declaration at a-textio.ads:264 -hello.adb:4:04: non-visible declaration at a-textio.ads:260 -gnatmake: "c:/Examples/Example_1/hello.adb" compilation error -@end smallexample - -If you have enabled font-lock, the lines with actual errors (starting -with @file{hello.adb}) are highlighted, with the file name in red. - -Now type @kbd{C-x `} (on a PC keyboard, @key{`} is next to @key{1}). -Or you can click the middle mouse button on the first error line. The -compilation buffer scrolls to put the first error on the top line, and -point is put at the place of the error in the @file{hello.adb} buffer. - -To fix the error, change the line to be - -@example - Ada.Text_IO.Put_Line ("hello from hello.adb"); -@end example - -Now invoke @samp{Ada | Show main}; this displays @samp{Ada mode main: hello}. - -Now (in buffer @file{hello.adb}), invoke @samp{Ada | Build}. You are -prompted to save the file (if you haven't already). Then the -compilation buffer is displayed again, containing: - -@example -cd c:/Examples/Example_1/ -gnatmake -o hello hello -g -cargs -gnatq -gnatQ -bargs -largs -gcc -c -g -gnatq -gnatQ hello.adb -gnatbind -x hello.ali -gnatlink hello.ali -o hello.exe -g -@end example - -The compilation has succeeded without errors; @file{hello.exe} now -exists in the same directory as @file{hello.adb}. - -Now invoke @samp{Ada | Run}. A @file{*run*} buffer is displayed, -containing - -@example -Hello from hello.adb - -Process run finished -@end example - -That completes the first part of this example. - -Now we will compile a multi-file project. Open the file -@file{hello_2.adb}, and invoke @samp{Ada | Set main and Build}. This -finds an error in @file{hello_pkg.adb}: - -@example -cd c:/Examples/Example_1/ -gnatmake -o hello_2 hello_2 -g -cargs -gnatq -gnatQ -bargs -largs -gcc -c -g -gnatq -gnatQ hello_pkg.adb -hello_pkg.adb:2:08: keyword "body" expected here [see file name] -gnatmake: "hello_pkg.adb" compilation error -@end example - -This demonstrates that gnatmake finds the files needed by the main -program. However, it cannot find files in a different directory, -unless you use an Emacs Ada mode project file to specify the other directories; -@xref{Set source search path}, or a GNAT project file; @ref{Use GNAT -project file}. - -Invoke @samp{Ada | Show main}; this displays @file{Ada mode main: hello_2}. - -Move to the error with @kbd{C-x `}, and fix the error by adding @code{body}: - -@example -package body Hello_Pkg is -@end example - -Now, while still in @file{hello_pkg.adb}, invoke @samp{Ada | Build}. -gnatmake successfully builds @file{hello_2}. This demonstrates that -Emacs has remembered the main file, in the project variable -@code{main}, and used it for the Build command. - -Finally, again while in @file{hello_pkg.adb}, invoke @samp{Ada | Run}. -The @file{*run*} buffer displays @code{Hello from hello_pkg.adb}. - -One final point. If you switch back to buffer @file{hello.adb}, and -invoke @samp{Ada | Run}, @file{hello_2.exe} will be run. That is -because @code{main} is still set to @code{hello_2}, as you can -see when you invoke @samp{Ada | Project | Edit}. - -There are three ways to change @code{main}: - -@enumerate -@item -Invoke @samp{Ada | Set main and Build}, which sets @code{main} to -the current file. - -@item -Invoke @samp{Ada | Project | Edit}, edit @code{main}, and click @samp{[save]} - -@item -Invoke @samp{Ada | Project | Load}, and load a project file that specifies @code{main} - -@end enumerate - -@node Set compiler options -@section Set compiler options - -This example illustrates using an Emacs Ada mode project file to set a -compiler option. - -If you have files from @file{Example_1} open in Emacs, you should -close them so you don't get confused. Use menu @samp{File | Close -(current buffer)}. - -In directory @file{Example_2}, create these files: - -@file{hello.adb}: - -@example -with Ada.Text_IO; -procedure Hello -is begin - Put_Line("Hello from hello.adb"); -end Hello; -@end example - -This is the same as @file{hello.adb} from @file{Example_1}. It has two -errors; missing ``use Ada.Text_IO;'', and no space between -@code{Put_Line} and its argument list. - -@file{hello.adp}: - -@example -comp_opt=-gnatyt -@end example - -This tells the GNAT compiler to check for token spacing; in -particular, there must be a space preceding a parenthesis. - -In buffer @file{hello.adb}, invoke @samp{Ada | Project | Load...}, and -select @file{Example_2/hello.adp}. - -Then, again in buffer @file{hello.adb}, invoke @samp{Ada | Set main and -Build}. You should get a @file{*compilation*} buffer containing -something like (the directory paths will be different): - -@example -cd c:/Examples/Example_2/ -gnatmake -o hello hello -g -cargs -gnatyt -bargs -largs -gcc -c -g -gnatyt hello.adb -hello.adb:4:04: "Put_Line" is not visible -hello.adb:4:04: non-visible declaration at a-textio.ads:264 -hello.adb:4:04: non-visible declaration at a-textio.ads:260 -hello.adb:4:12: (style) space required -gnatmake: "hello.adb" compilation error -@end example - -Compare this to the compiler output in @ref{No project files}; the -gnatmake option @code{-cargs -gnatq -gnatQ} has been replaced by -@code{-cargs -gnaty}, and an additional error is reported in -@file{hello.adb} on line 4. This shows that @file{hello.adp} is being -used to set the compiler options. - -Fixing the error, linking and running the code proceed as in @ref{No -project files}. - -@node Set source search path -@section Set source search path - -In this example, we show how to deal with files in more than one -directory. We start with the same code as in @ref{No project files}; -create those files (with the errors present) - -Create the directory @file{Example_3}, containing: - -@file{hello_pkg.ads}: - -@example -package Hello_Pkg is - procedure Say_Hello; -end Hello_Pkg; -@end example - -@file{hello_pkg.adb}: - -@example -with Ada.Text_IO; -package Hello_Pkg is - procedure Say_Hello - is begin - Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); - end Say_Hello; -end Hello_Pkg; -@end example - -These are the same files from example 1; @file{hello_pkg.adb} has an -error on line 2. - -In addition, create a directory @file{Example_3/Other}, containing these files: - -@file{Other/hello_3.adb}: - -@example -with Hello_Pkg; -with Ada.Text_IO; use Ada.Text_IO; -procedure Hello_3 -is begin - Hello_Pkg.Say_Hello; - Put_Line ("From hello_3"); -end Hello_3; -@end example - -There are no errors in this file. - -@file{Other/other.adp}: - -@example -src_dir=.. -comp_opt=-I.. -@end example - -Note that there must be no trailing spaces. - -In buffer @file{hello_3.adb}, invoke @samp{Ada | Project | Load...}, and -select @file{Example_3/Other/other.adp}. - -Then, again in @file{hello_3.adb}, invoke @samp{Ada | Set main and -Build}. You should get a @file{*compilation*} buffer containing -something like (the directory paths will be different): - -@example -cd c:/Examples/Example_3/Other/ -gnatmake -o hello_3 hello_3 -g -cargs -I.. -bargs -largs -gcc -c -g -I.. hello_3.adb -gcc -c -I./ -g -I.. -I- C:\Examples\Example_3\hello_pkg.adb -hello_pkg.adb:2:08: keyword "body" expected here [see file name] -gnatmake: "C:\Examples\Example_3\hello_pkg.adb" compilation error -@end example - -Compare the @code{-cargs} option to the compiler output in @ref{Set -compiler options}; this shows that @file{other.adp} is being used to -set the compiler options. - -Move to the error with @kbd{C-x `}. Ada mode searches the list of -directories given by @code{src_dir} for the file mentioned in the -compiler error message. - -Fixing the error, linking and running the code proceed as in @ref{No -project files}. - -@node Use GNAT project file -@section Use GNAT project file - -In this example, we show how to use a GNAT project file, with no Ada -mode project file. - -Create the directory @file{Example_4}, containing: - -@file{hello_pkg.ads}: - -@example -package Hello_Pkg is - procedure Say_Hello; -end Hello_Pkg; -@end example - -@file{hello_pkg.adb}: - -@example -with Ada.Text_IO; -package Hello_Pkg is - procedure Say_Hello - is begin - Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb"); - end Say_Hello; -end Hello_Pkg; -@end example - -These are the same files from example 1; @file{hello_pkg.adb} has an -error on line 2. - -In addition, create a directory @file{Example_4/Gnat_Project}, -containing these files: - -@file{Gnat_Project/hello_4.adb}: - -@example -with Hello_Pkg; -with Ada.Text_IO; use Ada.Text_IO; -procedure Hello_4 -is begin - Hello_Pkg.Say_Hello; - Put_Line ("From hello_4"); -end Hello_4; -@end example - -There are no errors in this file. - -@file{Gnat_Project/hello_4.gpr}: - -@example -Project Hello_4 is - for Source_Dirs use (".", ".."); -end Hello_4; -@end example - -In buffer @file{hello_4.adb}, invoke @samp{Ada | Project | Load...}, and -select @file{Example_4/Gnat_Project/hello_4.gpr}. - -Then, again in @file{hello_4.adb}, invoke @samp{Ada | Set main and -Build}. You should get a @file{*compilation*} buffer containing -something like (the directory paths will be different): - -@smallexample -cd c:/Examples/Example_4/Gnat_Project/ -gnatmake -o hello_4 hello_4 -Phello_4.gpr -cargs -gnatq -gnatQ -bargs -largs -gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\Gnat_Project\hello_4.adb -gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb -hello_pkg.adb:2:08: keyword "body" expected here [see file name] -gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error -@end smallexample - -Compare the @code{gcc} options to the compiler output in @ref{Set -compiler options}; this shows that @file{hello_4.gpr} is being used to -set the compiler options. - -Fixing the error, linking and running the code proceed as in @ref{No -project files}. - -@node Use multiple GNAT project files -@section Use multiple GNAT project files - -In this example, we show how to use multiple GNAT project files, -specifying the GNAT project search path in an Ada mode project file. - -Create the directory @file{Example_4} as specified in @ref{Use GNAT -project file}. - -Create the directory @file{Example_5}, containing: - -@file{hello_5.adb}: - -@example -with Hello_Pkg; -with Ada.Text_IO; use Ada.Text_IO; -procedure Hello_5 -is begin - Hello_Pkg.Say_Hello; - Put_Line ("From hello_5"); -end Hello_5; -@end example - -There are no errors in this file. - -@file{hello_5.adp}: - -@example -ada_project_path=../Example_4/Gnat_Project -gpr_file=hello_5.gpr -@end example - -@file{hello_5.gpr}: - -@example -with "hello_4"; -Project Hello_5 is - for Source_Dirs use ("."); - package Compiler is - for Default_Switches ("Ada") use ("-g", "-gnatyt"); - end Compiler; -end Hello_5; -@end example - -In buffer @file{hello_5.adb}, invoke @samp{Ada | Project | Load...}, and -select @file{Example_5/hello_5.adp}. - -Then, again in @file{hello_5.adb}, invoke @samp{Ada | Set main and -Build}. You should get a @file{*compilation*} buffer containing -something like (the directory paths will be different): - -@smallexample -cd c:/Examples/Example_5/ -gnatmake -o hello_5 hello_5 -Phello_5.gpr -g -cargs -gnatq -gnatQ -bargs -largs -gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_5\hello_5.adb -gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb -hello_pkg.adb:2:08: keyword "body" expected here [see file name] -gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error -@end smallexample - -Now type @kbd{C-x `}. @file{Example_4/hello_pkg.adb} is shown, -demonstrating that @file{hello_5.gpr} and @file{hello_4.gpr} are being -used to set the compilation search path. - -@node Moving Through Ada Code -@chapter Moving Through Ada Code - -There are several easy to use commands to navigate through Ada code. All -these functions are available through the Ada menu, and you can also -use the following key bindings or the command names. Some of these -menu entries are available only if the GNAT compiler is used, since -the implementation relies on the GNAT cross-referencing information. - -@table @kbd -@item M-C-e -@findex ada-next-procedure -Move to the next function/procedure/task, which ever comes next -(@code{ada-next-procedure}). -@item M-C-a -@findex ada-previous-procedure -Move to previous function/procedure/task -(@code{ada-previous-procedure}). -@item M-x ada-next-package -@findex ada-next-package -Move to next package. -@item M-x ada-previous-package -@findex ada-previous-package -Move to previous package. -@item C-c C-a -@findex ada-move-to-start -Move to matching start of @code{end} (@code{ada-move-to-start}). If -point is at the end of a subprogram, this command jumps to the -corresponding @code{begin} if the user option -@code{ada-move-to-declaration} is @code{nil} (default), otherwise it jumps to -the subprogram declaration. -@item C-c C-e -@findex ada-move-to-end -Move point to end of current block (@code{ada-move-to-end}). -@item C-c o -Switch between corresponding spec and body file -(@code{ff-find-other-file}). If point is in a subprogram, position -point on the corresponding declaration or body in the other file. -@item C-c c-d -@findex ada-goto-declaration -Move from any reference to its declaration, for from a declaration to -its body (for procedures, tasks, private and incomplete types). -@item C-c C-r -@findex ada-find-references -Runs the @file{gnatfind} command to search for all references to the -identifier surrounding point (@code{ada-find-references}). Use -@kbd{C-x `} (@code{next-error}) to visit each reference (as for -compilation errors). -@end table - -If the @code{ada-xref-create-ali} variable is non-@code{nil}, Emacs -will try to run GNAT for you whenever cross-reference information is -needed, and is older than the current source file. - -@node Identifier completion -@chapter Identifier completion - -Emacs and Ada mode provide two general ways for the completion of -identifiers. This is an easy way to type faster: you just have to type -the first few letters of an identifiers, and then loop through all the -possible completions. - -The first method is general for Emacs. It works by parsing all open -files for possible completions. - -For instance, if the words @samp{my_identifier}, @samp{my_subprogram} -are the only words starting with @samp{my} in any of the opened files, -then you will have this scenario: - -@example -You type: my@kbd{M-/} -Emacs inserts: @samp{my_identifier} -If you press @kbd{M-/} once again, Emacs replaces @samp{my_identifier} with -@samp{my_subprogram}. -Pressing @kbd{M-/} once more will bring you back to @samp{my_identifier}. -@end example - -This is a very fast way to do completion, and the casing of words will -also be respected. - -The second method (@kbd{C-@key{TAB}}) is specific to Ada mode and the GNAT -compiler. Emacs will search the cross-information for possible -completions. - -The main advantage is that this completion is more accurate: only -existing identifier will be suggested. - -On the other hand, this completion is a little bit slower and requires -that you have compiled your file at least once since you created that -identifier. - -@table @kbd -@item C-@key{TAB} -@findex ada-complete-identifier -Complete current identifier using cross-reference information. -@item M-/ -Complete identifier using buffer information (not Ada-specific). -@end table - -@node Automatic Smart Indentation -@chapter Automatic Smart Indentation - -Ada mode comes with a full set of rules for automatic indentation. You -can also configure the indentation, via the following variables: - -@table @asis -@item @code{ada-broken-indent} (default value: 2) -Number of columns to indent the continuation of a broken line. - -@item @code{ada-indent} (default value: 3) -Number of columns for default indentation. - -@item @code{ada-indent-record-rel-type} (default value: 3) -Indentation for @code{record} relative to @code{type} or @code{use}. - -@item @code{ada-indent-return} (default value: 0) -Indentation for @code{return} relative to @code{function} (if -@code{ada-indent-return} is greater than 0), or the open parenthesis -(if @code{ada-indent-return} is negative or 0). Note that in the second -case, when there is no open parenthesis, the indentation is done -relative to @code{function} with the value of @code{ada-broken-indent}. - -@item @code{ada-label-indent} (default value: -4) -Number of columns to indent a label. - -@item @code{ada-stmt-end-indent} (default value: 0) -Number of columns to indent a statement @code{end} keyword on a separate line. - -@item @code{ada-when-indent} (default value: 3) -Indentation for @code{when} relative to @code{exception} or @code{case}. - -@item @code{ada-indent-is-separate} (default value: t) -Non-@code{nil} means indent @code{is separate} or @code{is abstract} if on a single line. - -@item @code{ada-indent-to-open-paren} (default value: t) -Non-@code{nil} means indent according to the innermost open parenthesis. - -@item @code{ada-indent-after-return} (default value: t) -Non-@code{nil} means that the current line will also be re-indented -before inserting a newline, when you press @key{RET}. -@end table - -Most of the time, the indentation will be automatic, i.e., when you -press @key{RET}, the cursor will move to the correct column on the -next line. - -You can also indent single lines, or the current region, with @key{TAB}. - -Another mode of indentation exists that helps you to set up your -indentation scheme. If you press @kbd{C-c @key{TAB}}, Ada mode will do -the following: - -@itemize @bullet -@item -Reindent the current line, as @key{TAB} would do. -@item -Temporarily move the cursor to a reference line, i.e., the line that -was used to calculate the current indentation. -@item -Display in the message window the name of the variable that provided -the offset for the indentation. -@end itemize - -The exact indentation of the current line is the same as the one for the -reference line, plus an offset given by the variable. - -@table @kbd -@item @key{TAB} -Indent the current line or the current region. -@item C-M-\ -Indent lines in the current region. -@item C-c @key{TAB} -Indent the current line and display the name of the variable used for -indentation. -@end table - -@node Formatting Parameter Lists -@chapter Formatting Parameter Lists - -@table @kbd -@item C-c C-f -@findex ada-format-paramlist -Format the parameter list (@code{ada-format-paramlist}). -@end table - -This aligns the declarations on the colon (@samp{:}) separating -argument names and argument types, and aligns the @code{in}, -@code{out} and @code{in out} keywords. - -@node Automatic Casing -@chapter Automatic Casing - -Casing of identifiers, attributes and keywords is automatically -performed while typing when the variable @code{ada-auto-case} is set. -Every time you press a word separator, the previous word is -automatically cased. - -You can customize the automatic casing differently for keywords, -attributes and identifiers. The relevant variables are the following: -@code{ada-case-keyword}, @code{ada-case-attribute} and -@code{ada-case-identifier}. - -All these variables can have one of the following values: - -@table @code -@item downcase-word -The word will be lowercase. For instance @code{My_vARIable} is -converted to @code{my_variable}. - -@item upcase-word -The word will be uppercase. For instance @code{My_vARIable} is -converted to @code{MY_VARIABLE}. - -@item ada-capitalize-word -The first letter and each letter following an underscore (@samp{_}) -are uppercase, others are lowercase. For instance @code{My_vARIable} -is converted to @code{My_Variable}. - -@item ada-loose-case-word -Characters after an underscore @samp{_} character are uppercase, -others are not modified. For instance @code{My_vARIable} is converted -to @code{My_VARIable}. -@end table - -Ada mode allows you to define exceptions to these rules, in a file -specified by the variable @code{ada-case-exception-file} -(default @file{~/.emacs_case_exceptions}). Each line in this file -specifies the casing of one word or word fragment. Comments may be -included, separated from the word by a space. - -If the word starts with an asterisk (@samp{*}), it defines the casing -as a word fragment (or ``substring''); part of a word between two -underscores or word boundary. - -For example: - -@example -DOD Department of Defense -*IO -GNAT The GNAT compiler from Ada Core Technologies -@end example - -The word fragment @code{*IO} applies to any word containing ``_io''; -@code{Text_IO}, @code{Hardware_IO}, etc. - -@findex ada-create-case-exception -There are two ways to add new items to this file: you can simply edit -it as you would edit any text file. Or you can position point on the -word you want to add, and select menu @samp{Ada | Edit | Create Case -Exception}, or press @kbd{C-c C-y} (@code{ada-create-case-exception}). -The word will automatically be added to the current list of exceptions -and to the file. - -To define a word fragment case exception, select the word fragment, -then select menu @samp{Ada | Edit | Create Case Exception Substring}. - -It is sometimes useful to have multiple exception files around (for -instance, one could be the standard Ada acronyms, the second some -company specific exceptions, and the last one some project specific -exceptions). If you set up the variable @code{ada-case-exception-file} -as a list of files, each of them will be parsed and used in your emacs -session. However, when you save a new exception through the menu, as -described above, the new exception will be added to the first file in -the list. - -@table @kbd -@item C-c C-b -@findex ada-adjust-case-buffer -Adjust case in the whole buffer (@code{ada-adjust-case-buffer}). -@item C-c C-y -Create a new entry in the exception dictionary, with the word under -the cursor (@code{ada-create-case-exception}) -@item C-c C-t -@findex ada-case-read-exceptions -Rereads the exception dictionary from the file -@code{ada-case-exception-file} (@code{ada-case-read-exceptions}). -@end table - -@node Statement Templates -@chapter Statement Templates - -Templates are defined for most Ada statements, using the Emacs -``skeleton'' package. They can be inserted in the buffer using the -following commands: - -@table @kbd -@item C-c t b -@findex ada-exception-block -exception Block (@code{ada-exception-block}). -@item C-c t c -@findex ada-case -case (@code{ada-case}). -@item C-c t d -@findex ada-declare-block -declare Block (@code{ada-declare-block}). -@item C-c t e -@findex ada-else -else (@code{ada-else}). -@item C-c t f -@findex ada-for-loop -for Loop (@code{ada-for-loop}). -@item C-c t h -@findex ada-header -Header (@code{ada-header}). -@item C-c t i -@findex ada-if -if (@code{ada-if}). -@item C-c t k -@findex ada-package-body -package Body (@code{ada-package-body}). -@item C-c t l -@findex ada-loop -loop (@code{ada-loop}). -@item C-c p -@findex ada-subprogram-body -subprogram body (@code{ada-subprogram-body}). -@item C-c t t -@findex ada-task-body -task Body (@code{ada-task-body}). -@item C-c t w -@findex ada-while -while Loop (@code{ada-while}). -@item C-c t u -@findex ada-use -use (@code{ada-use}). -@item C-c t x -@findex ada-exit -exit (@code{ada-exit}). -@item C-c t C-a -@findex ada-array -array (@code{ada-array}). -@item C-c t C-e -@findex ada-elsif -elsif (@code{ada-elsif}). -@item C-c t C-f -@findex ada-function-spec -function Spec (@code{ada-function-spec}). -@item C-c t C-k -@findex ada-package-spec -package Spec (@code{ada-package-spec}). -@item C-c t C-p -@findex ada-procedure-spec -procedure Spec (@code{ada-package-spec}. -@item C-c t C-r -@findex ada-record -record (@code{ada-record}). -@item C-c t C-s -@findex ada-subtype -subtype (@code{ada-subtype}). -@item C-c t C-t -@findex ada-task-spec -task Spec (@code{ada-task-spec}). -@item C-c t C-u -@findex ada-with -with (@code{ada-with}). -@item C-c t C-v -@findex ada-private -private (@code{ada-private}). -@item C-c t C-w -@findex ada-when -when (@code{ada-when}). -@item C-c t C-x -@findex ada-exception -exception (@code{ada-exception}). -@item C-c t C-y -@findex ada-type -type (@code{ada-type}). -@end table - -@node Comment Handling -@chapter Comment Handling - -By default, comment lines get indented like Ada code. There are a few -additional functions to handle comments: - -@table @kbd -@item M-; -Start a comment in default column. -@item M-j -Continue comment on next line. -@item C-c ; -Comment the selected region (add @samp{--} at the beginning of lines). -@item C-c : -Uncomment the selected region -@item M-q -autofill the current comment. -@end table - -@node GNU Free Documentation License -@appendix GNU Free Documentation License -@include doclicense.texi - -@node Index -@unnumbered Index - -@printindex fn - -@bye diff --git a/old_ada/doc/build.sh b/old_ada/doc/build.sh deleted file mode 100755 index a0799fe..0000000 --- a/old_ada/doc/build.sh +++ /dev/null @@ -1,3 +0,0 @@ -#! /usr/bin/env bash -texi2any -o ada-mode.info --no-split ada-mode.texi -texi2any --html -o ada-mode.html --no-split ada-mode.texi diff --git a/old_ada/doc/clean.sh b/old_ada/doc/clean.sh deleted file mode 100755 index f7e90b1..0000000 --- a/old_ada/doc/clean.sh +++ /dev/null @@ -1,2 +0,0 @@ -#! /bin/sh -rm ada-mode.aux ada-mode.fn ada-mode.log ada-mode.toc diff --git a/old_ada/doc/doclicense.texi b/old_ada/doc/doclicense.texi deleted file mode 100644 index eaf3da0..0000000 --- a/old_ada/doc/doclicense.texi +++ /dev/null @@ -1,505 +0,0 @@ -@c The GNU Free Documentation License. -@center Version 1.3, 3 November 2008 - -@c This file is intended to be included within another document, -@c hence no sectioning command or @node. - -@display -Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. -@uref{https://fsf.org/} - -Everyone is permitted to copy and distribute verbatim copies -of this license document, but changing it is not allowed. -@end display - -@enumerate 0 -@item -PREAMBLE - -The purpose of this License is to make a manual, textbook, or other -functional and useful document @dfn{free} in the sense of freedom: to -assure everyone the effective freedom to copy and redistribute it, -with or without modifying it, either commercially or noncommercially. -Secondarily, this License preserves for the author and publisher a way -to get credit for their work, while not being considered responsible -for modifications made by others. - -This License is a kind of ``copyleft'', which means that derivative -works of the document must themselves be free in the same sense. It -complements the GNU General Public License, which is a copyleft -license designed for free software. - -We have designed this License in order to use it for manuals for free -software, because free software needs free documentation: a free -program should come with manuals providing the same freedoms that the -software does. But this License is not limited to software manuals; -it can be used for any textual work, regardless of subject matter or -whether it is published as a printed book. We recommend this License -principally for works whose purpose is instruction or reference. - -@item -APPLICABILITY AND DEFINITIONS - -This License applies to any manual or other work, in any medium, that -contains a notice placed by the copyright holder saying it can be -distributed under the terms of this License. Such a notice grants a -world-wide, royalty-free license, unlimited in duration, to use that -work under the conditions stated herein. The ``Document'', below, -refers to any such manual or work. Any member of the public is a -licensee, and is addressed as ``you''. You accept the license if you -copy, modify or distribute the work in a way requiring permission -under copyright law. - -A ``Modified Version'' of the Document means any work containing the -Document or a portion of it, either copied verbatim, or with -modifications and/or translated into another language. - -A ``Secondary Section'' is a named appendix or a front-matter section -of the Document that deals exclusively with the relationship of the -publishers or authors of the Document to the Document's overall -subject (or to related matters) and contains nothing that could fall -directly within that overall subject. (Thus, if the Document is in -part a textbook of mathematics, a Secondary Section may not explain -any mathematics.) The relationship could be a matter of historical -connection with the subject or with related matters, or of legal, -commercial, philosophical, ethical or political position regarding -them. - -The ``Invariant Sections'' are certain Secondary Sections whose titles -are designated, as being those of Invariant Sections, in the notice -that says that the Document is released under this License. If a -section does not fit the above definition of Secondary then it is not -allowed to be designated as Invariant. The Document may contain zero -Invariant Sections. If the Document does not identify any Invariant -Sections then there are none. - -The ``Cover Texts'' are certain short passages of text that are listed, -as Front-Cover Texts or Back-Cover Texts, in the notice that says that -the Document is released under this License. A Front-Cover Text may -be at most 5 words, and a Back-Cover Text may be at most 25 words. - -A ``Transparent'' copy of the Document means a machine-readable copy, -represented in a format whose specification is available to the -general public, that is suitable for revising the document -straightforwardly with generic text editors or (for images composed of -pixels) generic paint programs or (for drawings) some widely available -drawing editor, and that is suitable for input to text formatters or -for automatic translation to a variety of formats suitable for input -to text formatters. A copy made in an otherwise Transparent file -format whose markup, or absence of markup, has been arranged to thwart -or discourage subsequent modification by readers is not Transparent. -An image format is not Transparent if used for any substantial amount -of text. A copy that is not ``Transparent'' is called ``Opaque''. - -Examples of suitable formats for Transparent copies include plain -ASCII without markup, Texinfo input format, La@TeX{} input -format, SGML or XML using a publicly available -DTD, and standard-conforming simple HTML, -PostScript or PDF designed for human modification. Examples -of transparent image formats include PNG, XCF and -JPG@. Opaque formats include proprietary formats that can be -read and edited only by proprietary word processors, SGML or -XML for which the DTD and/or processing tools are -not generally available, and the machine-generated HTML, -PostScript or PDF produced by some word processors for -output purposes only. - -The ``Title Page'' means, for a printed book, the title page itself, -plus such following pages as are needed to hold, legibly, the material -this License requires to appear in the title page. For works in -formats which do not have any title page as such, ``Title Page'' means -the text near the most prominent appearance of the work's title, -preceding the beginning of the body of the text. - -The ``publisher'' means any person or entity that distributes copies -of the Document to the public. - -A section ``Entitled XYZ'' means a named subunit of the Document whose -title either is precisely XYZ or contains XYZ in parentheses following -text that translates XYZ in another language. (Here XYZ stands for a -specific section name mentioned below, such as ``Acknowledgements'', -``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title'' -of such a section when you modify the Document means that it remains a -section ``Entitled XYZ'' according to this definition. - -The Document may include Warranty Disclaimers next to the notice which -states that this License applies to the Document. These Warranty -Disclaimers are considered to be included by reference in this -License, but only as regards disclaiming warranties: any other -implication that these Warranty Disclaimers may have is void and has -no effect on the meaning of this License. - -@item -VERBATIM COPYING - -You may copy and distribute the Document in any medium, either -commercially or noncommercially, provided that this License, the -copyright notices, and the license notice saying this License applies -to the Document are reproduced in all copies, and that you add no other -conditions whatsoever to those of this License. You may not use -technical measures to obstruct or control the reading or further -copying of the copies you make or distribute. However, you may accept -compensation in exchange for copies. If you distribute a large enough -number of copies you must also follow the conditions in section 3. - -You may also lend copies, under the same conditions stated above, and -you may publicly display copies. - -@item -COPYING IN QUANTITY - -If you publish printed copies (or copies in media that commonly have -printed covers) of the Document, numbering more than 100, and the -Document's license notice requires Cover Texts, you must enclose the -copies in covers that carry, clearly and legibly, all these Cover -Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on -the back cover. Both covers must also clearly and legibly identify -you as the publisher of these copies. The front cover must present -the full title with all words of the title equally prominent and -visible. You may add other material on the covers in addition. -Copying with changes limited to the covers, as long as they preserve -the title of the Document and satisfy these conditions, can be treated -as verbatim copying in other respects. - -If the required texts for either cover are too voluminous to fit -legibly, you should put the first ones listed (as many as fit -reasonably) on the actual cover, and continue the rest onto adjacent -pages. - -If you publish or distribute Opaque copies of the Document numbering -more than 100, you must either include a machine-readable Transparent -copy along with each Opaque copy, or state in or with each Opaque copy -a computer-network location from which the general network-using -public has access to download using public-standard network protocols -a complete Transparent copy of the Document, free of added material. -If you use the latter option, you must take reasonably prudent steps, -when you begin distribution of Opaque copies in quantity, to ensure -that this Transparent copy will remain thus accessible at the stated -location until at least one year after the last time you distribute an -Opaque copy (directly or through your agents or retailers) of that -edition to the public. - -It is requested, but not required, that you contact the authors of the -Document well before redistributing any large number of copies, to give -them a chance to provide you with an updated version of the Document. - -@item -MODIFICATIONS - -You may copy and distribute a Modified Version of the Document under -the conditions of sections 2 and 3 above, provided that you release -the Modified Version under precisely this License, with the Modified -Version filling the role of the Document, thus licensing distribution -and modification of the Modified Version to whoever possesses a copy -of it. In addition, you must do these things in the Modified Version: - -@enumerate A -@item -Use in the Title Page (and on the covers, if any) a title distinct -from that of the Document, and from those of previous versions -(which should, if there were any, be listed in the History section -of the Document). You may use the same title as a previous version -if the original publisher of that version gives permission. - -@item -List on the Title Page, as authors, one or more persons or entities -responsible for authorship of the modifications in the Modified -Version, together with at least five of the principal authors of the -Document (all of its principal authors, if it has fewer than five), -unless they release you from this requirement. - -@item -State on the Title page the name of the publisher of the -Modified Version, as the publisher. - -@item -Preserve all the copyright notices of the Document. - -@item -Add an appropriate copyright notice for your modifications -adjacent to the other copyright notices. - -@item -Include, immediately after the copyright notices, a license notice -giving the public permission to use the Modified Version under the -terms of this License, in the form shown in the Addendum below. - -@item -Preserve in that license notice the full lists of Invariant Sections -and required Cover Texts given in the Document's license notice. - -@item -Include an unaltered copy of this License. - -@item -Preserve the section Entitled ``History'', Preserve its Title, and add -to it an item stating at least the title, year, new authors, and -publisher of the Modified Version as given on the Title Page. If -there is no section Entitled ``History'' in the Document, create one -stating the title, year, authors, and publisher of the Document as -given on its Title Page, then add an item describing the Modified -Version as stated in the previous sentence. - -@item -Preserve the network location, if any, given in the Document for -public access to a Transparent copy of the Document, and likewise -the network locations given in the Document for previous versions -it was based on. These may be placed in the ``History'' section. -You may omit a network location for a work that was published at -least four years before the Document itself, or if the original -publisher of the version it refers to gives permission. - -@item -For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve -the Title of the section, and preserve in the section all the -substance and tone of each of the contributor acknowledgements and/or -dedications given therein. - -@item -Preserve all the Invariant Sections of the Document, -unaltered in their text and in their titles. Section numbers -or the equivalent are not considered part of the section titles. - -@item -Delete any section Entitled ``Endorsements''. Such a section -may not be included in the Modified Version. - -@item -Do not retitle any existing section to be Entitled ``Endorsements'' or -to conflict in title with any Invariant Section. - -@item -Preserve any Warranty Disclaimers. -@end enumerate - -If the Modified Version includes new front-matter sections or -appendices that qualify as Secondary Sections and contain no material -copied from the Document, you may at your option designate some or all -of these sections as invariant. To do this, add their titles to the -list of Invariant Sections in the Modified Version's license notice. -These titles must be distinct from any other section titles. - -You may add a section Entitled ``Endorsements'', provided it contains -nothing but endorsements of your Modified Version by various -parties---for example, statements of peer review or that the text has -been approved by an organization as the authoritative definition of a -standard. - -You may add a passage of up to five words as a Front-Cover Text, and a -passage of up to 25 words as a Back-Cover Text, to the end of the list -of Cover Texts in the Modified Version. Only one passage of -Front-Cover Text and one of Back-Cover Text may be added by (or -through arrangements made by) any one entity. If the Document already -includes a cover text for the same cover, previously added by you or -by arrangement made by the same entity you are acting on behalf of, -you may not add another; but you may replace the old one, on explicit -permission from the previous publisher that added the old one. - -The author(s) and publisher(s) of the Document do not by this License -give permission to use their names for publicity for or to assert or -imply endorsement of any Modified Version. - -@item -COMBINING DOCUMENTS - -You may combine the Document with other documents released under this -License, under the terms defined in section 4 above for modified -versions, provided that you include in the combination all of the -Invariant Sections of all of the original documents, unmodified, and -list them all as Invariant Sections of your combined work in its -license notice, and that you preserve all their Warranty Disclaimers. - -The combined work need only contain one copy of this License, and -multiple identical Invariant Sections may be replaced with a single -copy. If there are multiple Invariant Sections with the same name but -different contents, make the title of each such section unique by -adding at the end of it, in parentheses, the name of the original -author or publisher of that section if known, or else a unique number. -Make the same adjustment to the section titles in the list of -Invariant Sections in the license notice of the combined work. - -In the combination, you must combine any sections Entitled ``History'' -in the various original documents, forming one section Entitled -``History''; likewise combine any sections Entitled ``Acknowledgements'', -and any sections Entitled ``Dedications''. You must delete all -sections Entitled ``Endorsements.'' - -@item -COLLECTIONS OF DOCUMENTS - -You may make a collection consisting of the Document and other documents -released under this License, and replace the individual copies of this -License in the various documents with a single copy that is included in -the collection, provided that you follow the rules of this License for -verbatim copying of each of the documents in all other respects. - -You may extract a single document from such a collection, and distribute -it individually under this License, provided you insert a copy of this -License into the extracted document, and follow this License in all -other respects regarding verbatim copying of that document. - -@item -AGGREGATION WITH INDEPENDENT WORKS - -A compilation of the Document or its derivatives with other separate -and independent documents or works, in or on a volume of a storage or -distribution medium, is called an ``aggregate'' if the copyright -resulting from the compilation is not used to limit the legal rights -of the compilation's users beyond what the individual works permit. -When the Document is included in an aggregate, this License does not -apply to the other works in the aggregate which are not themselves -derivative works of the Document. - -If the Cover Text requirement of section 3 is applicable to these -copies of the Document, then if the Document is less than one half of -the entire aggregate, the Document's Cover Texts may be placed on -covers that bracket the Document within the aggregate, or the -electronic equivalent of covers if the Document is in electronic form. -Otherwise they must appear on printed covers that bracket the whole -aggregate. - -@item -TRANSLATION - -Translation is considered a kind of modification, so you may -distribute translations of the Document under the terms of section 4. -Replacing Invariant Sections with translations requires special -permission from their copyright holders, but you may include -translations of some or all Invariant Sections in addition to the -original versions of these Invariant Sections. You may include a -translation of this License, and all the license notices in the -Document, and any Warranty Disclaimers, provided that you also include -the original English version of this License and the original versions -of those notices and disclaimers. In case of a disagreement between -the translation and the original version of this License or a notice -or disclaimer, the original version will prevail. - -If a section in the Document is Entitled ``Acknowledgements'', -``Dedications'', or ``History'', the requirement (section 4) to Preserve -its Title (section 1) will typically require changing the actual -title. - -@item -TERMINATION - -You may not copy, modify, sublicense, or distribute the Document -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense, or distribute it is void, and -will automatically terminate your rights under this License. - -However, if you cease all violation of this License, then your license -from a particular copyright holder is reinstated (a) provisionally, -unless and until the copyright holder explicitly and finally -terminates your license, and (b) permanently, if the copyright holder -fails to notify you of the violation by some reasonable means prior to -60 days after the cessation. - -Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - -Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, receipt of a copy of some or all of the same material does -not give you any rights to use it. - -@item -FUTURE REVISIONS OF THIS LICENSE - -The Free Software Foundation may publish new, revised versions -of the GNU Free Documentation License from time to time. Such new -versions will be similar in spirit to the present version, but may -differ in detail to address new problems or concerns. See -@uref{https://www.gnu.org/licenses/}. - -Each version of the License is given a distinguishing version number. -If the Document specifies that a particular numbered version of this -License ``or any later version'' applies to it, you have the option of -following the terms and conditions either of that specified version or -of any later version that has been published (not as a draft) by the -Free Software Foundation. If the Document does not specify a version -number of this License, you may choose any version ever published (not -as a draft) by the Free Software Foundation. If the Document -specifies that a proxy can decide which future versions of this -License can be used, that proxy's public statement of acceptance of a -version permanently authorizes you to choose that version for the -Document. - -@item -RELICENSING - -``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any -World Wide Web server that publishes copyrightable works and also -provides prominent facilities for anybody to edit those works. A -public wiki that anybody can edit is an example of such a server. A -``Massive Multiauthor Collaboration'' (or ``MMC'') contained in the -site means any set of copyrightable works thus published on the MMC -site. - -``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0 -license published by Creative Commons Corporation, a not-for-profit -corporation with a principal place of business in San Francisco, -California, as well as future copyleft versions of that license -published by that same organization. - -``Incorporate'' means to publish or republish a Document, in whole or -in part, as part of another Document. - -An MMC is ``eligible for relicensing'' if it is licensed under this -License, and if all works that were first published under this License -somewhere other than this MMC, and subsequently incorporated in whole -or in part into the MMC, (1) had no cover texts or invariant sections, -and (2) were thus incorporated prior to November 1, 2008. - -The operator of an MMC Site may republish an MMC contained in the site -under CC-BY-SA on the same site at any time before August 1, 2009, -provided the MMC is eligible for relicensing. - -@end enumerate - -@page -@heading ADDENDUM: How to use this License for your documents - -To use this License in a document you have written, include a copy of -the License in the document and put the following copyright and -license notices just after the title page: - -@smallexample -@group - Copyright (C) @var{year} @var{your name}. - Permission is granted to copy, distribute and/or modify this document - under the terms of the GNU Free Documentation License, Version 1.3 - or any later version published by the Free Software Foundation; - with no Invariant Sections, no Front-Cover Texts, and no Back-Cover - Texts. A copy of the license is included in the section entitled ``GNU - Free Documentation License''. -@end group -@end smallexample - -If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, -replace the ``with@dots{}Texts.''@: line with this: - -@smallexample -@group - with the Invariant Sections being @var{list their titles}, with - the Front-Cover Texts being @var{list}, and with the Back-Cover Texts - being @var{list}. -@end group -@end smallexample - -If you have Invariant Sections without Cover Texts, or some other -combination of the three, merge those two alternatives to suit the -situation. - -If your document contains nontrivial examples of program code, we -recommend releasing these examples in parallel under your choice of -free software license, such as the GNU General Public License, -to permit their use in free software. - -@c Local Variables: -@c ispell-local-pdict: "ispell-dict" -@c End: diff --git a/old_ada/doc/docstyle.texi b/old_ada/doc/docstyle.texi deleted file mode 100644 index e740439..0000000 --- a/old_ada/doc/docstyle.texi +++ /dev/null @@ -1,19 +0,0 @@ -@c Emacs documentation style settings -@documentencoding UTF-8 -@c These two require Texinfo 5.0 or later, so we use the older -@c equivalent @set variables supported in 4.11 and hence -@ignore -@codequotebacktick on -@codequoteundirected on -@end ignore -@set txicodequoteundirected -@set txicodequotebacktick -@iftex -@c It turns out TeX sometimes fails to hyphenate, so we help it here -@hyphenation{au-to-mat-i-cal-ly} -@hyphenation{spec-i-fied} -@hyphenation{work-a-round} -@hyphenation{work-a-rounds} -@hyphenation{un-marked} -@hyphenation{dic-tion-ary} -@end iftex -- cgit v1.2.3