emacs-goodies-el-35.8ubuntu2/0000775000000000000000000000000012230377267013014 5ustar emacs-goodies-el-35.8ubuntu2/COPYING-GPL-v20000775000000000000000000004310312230377265015016 0ustar GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) 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 this service 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 make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. 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. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), 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 distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the 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 a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE 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. 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 convey 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 2 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, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision 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, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This 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. emacs-goodies-el-35.8ubuntu2/COPYING-GPL-v30000775000000000000000000010437412230377265015027 0ustar 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 . emacs-goodies-el-35.8ubuntu2/00AddingFiles0000775000000000000000000000460012230377265015251 0ustar This is a checklist for adding files to the emacs-goodies-el package. - Make sure the upstream file can be used and customized using only the custom interface. Users should not have to edit ~/.emacs themselves. - copy the file to elisp/emacs-goodies-el/ and add them to CVS. $ cvs add elisp/emacs-goodies-el/minibuf-electric.el $ cvs commit -m "New files." elisp/emacs-goodies-el/minibuf-electric.el - When files are maintained by us, do it in CVS. When files have an upstream maintainer, submit patches upstream. If not responsive, handle them by creating a new "quilt" patch in debian/patches. - Make sure all interactive commands that are entry points into the file have autoload cookies. (This following step is no longer done, as the emacs-goodies-loaddefs.el file is generated at install time now: # # Update the `emacs-goodies-loaddefs.el' file by running: # # $ debian/rules patch # $ cd elisp/emacs-goodies-el # $ sh emacs-goodies-loaddefs.make # $ cd - # $ debian/rules unpatch ) - Update `emacs-goodies-custom.el' by adding a modified copy of the file's defgroup. Add lines for `:load' and a `:group 'emacs-goodies-el'. - Add whatever required startup and setup code that doesn't fit in the above files to `emacs-goodies-el.el'. This gets loaded at Emacs startup. - Add documentation in alphabetical order to `emacs-goodies-el.texi' Then from the Texinfo menu, invoke `Update Every Node' and `Create Master Menu'. Then fill-in a description in the top menu for the added entry. Test it: mkdir info makeinfo emacs-goodies-el info -f info/emacs-goodies-el rm -fR info Debian Files ~~~~~~~~~~~~ README.Debian - add a short description of the new file. control - add a one-line file description. changelog - close the wishlist bug, if any. emacs-goodies-el.copyright - add a boxquote'd blurb for the file. emacs-goodies-el.emacsen-install.in - add exclusions for incompatible flavors of Emacs. emacs-goodies-el.install - add a one-line entry to install the file Testing the Package ~~~~~~~~~~~~~~~~~~~ $ ./make-orig.sh $ cd ../build_25.1-1/emacs-goodies-el $ fakeroot debian/rules binary or $ dpkg-buildpackage -rfakeroot Releasing the package ~~~~~~~~~~~~~~~~~~~~~ - Set the distribution to "unstable" - See "Testing the Package" to build. - Tag the files in CVS, e.g. for version 25.1-1 : $ cvs tag debian_version_25_1-1 emacs-goodies-el-35.8ubuntu2/elisp/0000775000000000000000000000000012230377267014130 5ustar emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/0000775000000000000000000000000012230377267017245 5ustar emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/color-theme-library.el0000775000000000000000000302625412230377265023464 0ustar ;;; color-theme-library.el --- The real color theme functions ;; Copyright (C) 2005, 2006 Xavier Maillard ;; Copyright (C) 2005, 2006 Brian Palmer ;; Version: 0.0.9 ;; Keywords: faces ;; Author: Brian Palmer, Xavier Maillard ;; Maintainer: Xavier Maillard ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorTheme ;; This file is not (YET) part of GNU Emacs. ;; This 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 2, or (at your option) any later ;; version. ;; ;; This 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; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. ;; Code: (eval-when-compile (require 'color-theme)) (defun color-theme-gnome () "Wheat on darkslategrey scheme. From one version of Emacs in RH6 and Gnome, modified by Jonadab." (interactive) (color-theme-install '(color-theme-gnome ((foreground-color . "wheat") (background-color . "darkslategrey") (background-mode . dark)) (default ((t (nil)))) (region ((t (:foreground "cyan" :background "dark cyan")))) (underline ((t (:foreground "yellow" :underline t)))) (modeline ((t (:foreground "dark cyan" :background "wheat")))) (modeline-buffer-id ((t (:foreground "dark cyan" :background "wheat")))) (modeline-mousable ((t (:foreground "dark cyan" :background "wheat")))) (modeline-mousable-minor-mode ((t (:foreground "dark cyan" :background "wheat")))) (italic ((t (:foreground "dark red" :italic t)))) (bold-italic ((t (:foreground "dark red" :bold t :italic t)))) (font-lock-comment-face ((t (:foreground "Firebrick")))) (bold ((t (:bold))))))) (defun color-theme-blue-gnus () "Color theme for gnus and message faces only. This is intended for other color themes to use (eg. `color-theme-gnome2' and `color-theme-blue-sea')." (interactive) (color-theme-install '(color-theme-blue-gnus nil (gnus-cite-attribution-face ((t (:lforeground "lemon chiffon" :bold t)))) (gnus-cite-face-1 ((t (:foreground "LightSalmon")))) (gnus-cite-face-2 ((t (:foreground "Khaki")))) (gnus-cite-face-3 ((t (:foreground "Coral")))) (gnus-cite-face-4 ((t (:foreground "yellow green")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "bisque")))) (gnus-cite-face-7 ((t (:foreground "peru")))) (gnus-cite-face-8 ((t (:foreground "light coral")))) (gnus-cite-face-9 ((t (:foreground "plum")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) (gnus-group-mail-1-empty-face ((t (:foreground "White")))) (gnus-group-mail-1-face ((t (:bold t :foreground "White")))) (gnus-group-mail-2-empty-face ((t (:foreground "light cyan")))) (gnus-group-mail-2-face ((t (:bold t :foreground "light cyan")))) (gnus-group-mail-3-empty-face ((t (:foreground "LightBlue")))) (gnus-group-mail-3-face ((t (:bold t :foreground "LightBlue")))) (gnus-group-mail-low-empty-face ((t (:foreground "Aquamarine")))) (gnus-group-mail-low-face ((t (:bold t :foreground "Aquamarine")))) (gnus-group-news-1-empty-face ((t (:foreground "White")))) (gnus-group-news-1-face ((t (:bold t :foreground "White")))) (gnus-group-news-2-empty-face ((t (:foreground "light cyan")))) (gnus-group-news-2-face ((t (:bold t :foreground "light cyan")))) (gnus-group-news-3-empty-face ((t (:foreground "LightBlue")))) (gnus-group-news-3-face ((t (:bold t :foreground "LightBlue")))) (gnus-group-news-4-empty-face ((t (:foreground "Aquamarine")))) (gnus-group-news-4-face ((t (:bold t :foreground "Aquamarine")))) (gnus-group-news-5-empty-face ((t (:foreground "MediumAquamarine")))) (gnus-group-news-5-face ((t (:bold t :foreground "MediumAquamarine")))) (gnus-group-news-6-empty-face ((t (:foreground "MediumAquamarine")))) (gnus-group-news-6-face ((t (:bold t :foreground "MediumAquamarine")))) (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine")))) (gnus-header-content-face ((t (:foreground "LightSkyBlue3")))) (gnus-header-from-face ((t (:bold t :foreground "light cyan")))) (gnus-header-name-face ((t (:bold t :foreground "LightBlue")))) (gnus-header-newsgroups-face ((t (:bold t :foreground "MediumAquamarine")))) (gnus-header-subject-face ((t (:bold t :foreground "light cyan")))) (gnus-signature-face ((t (:foreground "Grey")))) (gnus-splash-face ((t (:foreground "ForestGreen")))) (gnus-summary-cancelled-face ((t (:background "Black" :foreground "Yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "MediumAquamarine")))) (gnus-summary-high-read-face ((t (:bold t :foreground "Aquamarine")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "LightSalmon")))) (gnus-summary-high-unread-face ((t (:bold t :foreground "beige")))) (gnus-summary-low-ancient-face ((t (:foreground "DimGray")))) (gnus-summary-low-read-face ((t (:foreground "slate gray")))) (gnus-summary-low-ticked-face ((t (:foreground "Pink")))) (gnus-summary-low-unread-face ((t (:foreground "LightGray")))) (gnus-summary-normal-ancient-face ((t (:foreground "MediumAquamarine")))) (gnus-summary-normal-read-face ((t (:foreground "Aquamarine")))) (gnus-summary-normal-ticked-face ((t (:foreground "LightSalmon")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:background "DarkSlateBlue")))) (message-cited-text-face ((t (:foreground "LightSalmon")))) (message-header-cc-face ((t (:foreground "light cyan")))) (message-header-name-face ((t (:foreground "LightBlue")))) (message-header-newsgroups-face ((t (:bold t :foreground "MediumAquamarine")))) (message-header-other-face ((t (:foreground "MediumAquamarine")))) (message-header-subject-face ((t (:bold t :foreground "light cyan")))) (message-header-to-face ((t (:bold t :foreground "light cyan")))) (message-header-xheader-face ((t (:foreground "MediumAquamarine")))) (message-separator-face ((t (:foreground "chocolate"))))))) (defun color-theme-dark-gnus () "Color theme for gnus and message faces only. This is intended for other color themes to use \(eg. `color-theme-late-night')." (interactive) (color-theme-install '(color-theme-blue-gnus nil (gnus-cite-attribution-face ((t (:foreground "#bbb")))) (gnus-cite-face-1 ((t (:foreground "#aaa")))) (gnus-cite-face-2 ((t (:foreground "#aaa")))) (gnus-cite-face-3 ((t (:foreground "#aaa")))) (gnus-cite-face-4 ((t (:foreground "#aaa")))) (gnus-cite-face-5 ((t (:foreground "#aaa")))) (gnus-cite-face-6 ((t (:foreground "#aaa")))) (gnus-cite-face-7 ((t (:foreground "#aaa")))) (gnus-cite-face-8 ((t (:foreground "#aaa")))) (gnus-cite-face-9 ((t (:foreground "#aaa")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:foreground "#ccc")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) (gnus-group-mail-1-empty-face ((t (:foreground "#999")))) (gnus-group-mail-1-face ((t (:bold t :foreground "#999")))) (gnus-group-mail-2-empty-face ((t (:foreground "#999")))) (gnus-group-mail-2-face ((t (:bold t :foreground "#999")))) (gnus-group-mail-3-empty-face ((t (:foreground "#888")))) (gnus-group-mail-3-face ((t (:bold t :foreground "#888")))) (gnus-group-mail-low-empty-face ((t (:foreground "#777")))) (gnus-group-mail-low-face ((t (:bold t :foreground "#777")))) (gnus-group-news-1-empty-face ((t (:foreground "#999")))) (gnus-group-news-1-face ((t (:bold t :foreground "#999")))) (gnus-group-news-2-empty-face ((t (:foreground "#888")))) (gnus-group-news-2-face ((t (:bold t :foreground "#888")))) (gnus-group-news-3-empty-face ((t (:foreground "#777")))) (gnus-group-news-3-face ((t (:bold t :foreground "#777")))) (gnus-group-news-4-empty-face ((t (:foreground "#666")))) (gnus-group-news-4-face ((t (:bold t :foreground "#666")))) (gnus-group-news-5-empty-face ((t (:foreground "#666")))) (gnus-group-news-5-face ((t (:bold t :foreground "#666")))) (gnus-group-news-6-empty-face ((t (:foreground "#666")))) (gnus-group-news-6-face ((t (:bold t :foreground "#666")))) (gnus-group-news-low-empty-face ((t (:foreground "#666")))) (gnus-group-news-low-face ((t (:bold t :foreground "#666")))) (gnus-header-content-face ((t (:foreground "#888")))) (gnus-header-from-face ((t (:bold t :foreground "#888")))) (gnus-header-name-face ((t (:bold t :foreground "#777")))) (gnus-header-newsgroups-face ((t (:bold t :foreground "#777")))) (gnus-header-subject-face ((t (:bold t :foreground "#999")))) (gnus-signature-face ((t (:foreground "#444")))) (gnus-splash-face ((t (:foreground "#ccc")))) (gnus-summary-cancelled-face ((t (:background "#555" :foreground "#000")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "#555")))) (gnus-summary-high-read-face ((t (:bold t :foreground "#666")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "#777")))) (gnus-summary-high-unread-face ((t (:bold t :foreground "#888")))) (gnus-summary-low-ancient-face ((t (:foreground "#444")))) (gnus-summary-low-read-face ((t (:foreground "#555")))) (gnus-summary-low-ticked-face ((t (:foreground "#666")))) (gnus-summary-low-unread-face ((t (:foreground "#777")))) (gnus-summary-normal-ancient-face ((t (:foreground "#555")))) (gnus-summary-normal-read-face ((t (:foreground "#666")))) (gnus-summary-normal-ticked-face ((t (:foreground "#777")))) (gnus-summary-normal-unread-face ((t (:foreground "#888")))) (gnus-summary-selected-face ((t (:background "#333")))) (message-cited-text-face ((t (:foreground "#aaa")))) (message-header-cc-face ((t (:foreground "#888")))) (message-header-name-face ((t (:bold t :foreground "#777")))) (message-header-newsgroups-face ((t (:bold t :foreground "#777")))) (message-header-other-face ((t (:foreground "#666")))) (message-header-subject-face ((t (:bold t :foreground "#999")))) (message-header-to-face ((t (:bold t :foreground "#777")))) (message-header-xheader-face ((t (:foreground "#666")))) (message-separator-face ((t (:foreground "#999"))))))) (defun color-theme-blue-eshell () "Color theme for eshell faces only. This is intended for other color themes to use (eg. `color-theme-gnome2')." (interactive) (color-theme-install '(color-theme-blue-eshell nil (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) (eshell-ls-backup-face ((t (:foreground "Grey")))) (eshell-ls-clutter-face ((t (:foreground "DimGray")))) (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue")))) (eshell-ls-executable-face ((t (:foreground "Coral")))) (eshell-ls-missing-face ((t (:foreground "black")))) (eshell-ls-picture-face ((t (:foreground "Violet")))) ; non-standard face (eshell-ls-product-face ((t (:foreground "LightSalmon")))) (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) (eshell-ls-special-face ((t (:foreground "Gold")))) (eshell-ls-symlink-face ((t (:foreground "White")))) (eshell-ls-text-face ((t (:foreground "medium aquamarine")))) ; non-standard face (eshell-ls-todo-face ((t (:bold t :foreground "aquamarine")))) ; non-standard face (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) (eshell-prompt-face ((t (:foreground "powder blue"))))))) (defun color-theme-salmon-font-lock () "Color theme for font-lock faces only. This is intended for other color themes to use (eg. `color-theme-gnome2')." (interactive) (color-theme-install '(color-theme-salmon-font-lock nil (font-lock-builtin-face ((t (:bold t :foreground "PaleGreen")))) (font-lock-comment-face ((t (:foreground "LightBlue")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) (font-lock-function-name-face ((t (:bold t :foreground "Aquamarine")))) (font-lock-keyword-face ((t (:foreground "Salmon")))) (font-lock-preprocessor-face ((t (:foreground "Salmon")))) (font-lock-reference-face ((t (:foreground "pale green")))) (font-lock-string-face ((t (:foreground "LightSalmon")))) (font-lock-type-face ((t (:bold t :foreground "YellowGreen")))) (font-lock-variable-name-face ((t (:bold t :foreground "Aquamarine")))) (font-lock-warning-face ((t (:bold t :foreground "red"))))))) (defun color-theme-dark-font-lock () "Color theme for font-lock faces only. This is intended for other color themes to use (eg. `color-theme-late-night')." (interactive) (color-theme-install '(color-theme-dark-font-lock nil (font-lock-builtin-face ((t (:bold t :foreground "#777")))) (font-lock-comment-face ((t (:foreground "#555")))) (font-lock-constant-face ((t (:foreground "#777")))) (font-lock-doc-string-face ((t (:foreground "#777")))) (font-lock-doc-face ((t (:foreground "#777")))) (font-lock-function-name-face ((t (:bold t :foreground "#777")))) (font-lock-keyword-face ((t (:foreground "#777")))) (font-lock-preprocessor-face ((t (:foreground "#777")))) (font-lock-reference-face ((t (:foreground "#777")))) (font-lock-string-face ((t (:foreground "#777")))) (font-lock-type-face ((t (:bold t)))) (font-lock-variable-name-face ((t (:bold t :foreground "#888")))) (font-lock-warning-face ((t (:bold t :foreground "#999"))))))) (defun color-theme-dark-info () "Color theme for info, help and apropos faces. This is intended for other color themes to use (eg. `color-theme-late-night')." (interactive) (color-theme-install '(color-theme-dark-info nil (info-header-node ((t (:foreground "#666")))) (info-header-xref ((t (:foreground "#666")))) (info-menu-5 ((t (:underline t)))) (info-menu-header ((t (:bold t :foreground "#666")))) (info-node ((t (:bold t :foreground "#888")))) (info-xref ((t (:bold t :foreground "#777"))))))) (defun color-theme-gnome2 () "Wheat on darkslategrey scheme. `color-theme-gnome' started it all. This theme supports standard faces, font-lock, eshell, info, message, gnus, custom, widget, woman, diary, cperl, bbdb, and erc. This theme includes faces for Emacs and XEmacs. The theme does not support w3 faces because w3 faces can be controlled by your default style sheet. This is what you should put in your .Xdefaults file, if you want to change the colors of the menus in Emacs 20 as well: emacs*Background: DarkSlateGray emacs*Foreground: Wheat" (interactive) (color-theme-blue-gnus) (let ((color-theme-is-cumulative t)) (color-theme-blue-erc) (color-theme-blue-eshell) (color-theme-salmon-font-lock) (color-theme-salmon-diff) (color-theme-install '(color-theme-gnome2 ((foreground-color . "wheat") (background-color . "darkslategrey") (mouse-color . "Grey") (cursor-color . "LightGray") (border-color . "black") (background-mode . dark)) ((apropos-keybinding-face . underline) (apropos-label-face . italic) (apropos-match-face . secondary-selection) (apropos-property-face . bold-italic) (apropos-symbol-face . info-xref) (goto-address-mail-face . message-header-to-face) (goto-address-mail-mouse-face . secondary-selection) (goto-address-url-face . info-xref) (goto-address-url-mouse-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (default ((t (nil)))) (bbdb-company ((t (:foreground "pale green")))) (bbdb-name ((t (:bold t :foreground "pale green")))) (bbdb-field-name ((t (:foreground "medium sea green")))) (bbdb-field-value ((t (:foreground "dark sea green")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t :foreground "beige")))) (calendar-today-face ((t (:underline t)))) (comint-highlight-prompt ((t (:foreground "medium aquamarine")))) (cperl-array-face ((t (:foreground "Yellow")))) (cperl-hash-face ((t (:foreground "White")))) (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) (custom-button-face ((t (:underline t :foreground "MediumSlateBlue")))) (custom-documentation-face ((t (:foreground "Grey")))) (custom-group-tag-face ((t (:foreground "MediumAquamarine")))) (custom-state-face ((t (:foreground "LightSalmon")))) (custom-variable-tag-face ((t (:foreground "Aquamarine")))) (diary-face ((t (:foreground "IndianRed")))) (dired-face-directory ((t (:bold t :foreground "sky blue")))) (dired-face-permissions ((t (:foreground "aquamarine")))) (dired-face-flagged ((t (:foreground "tomato")))) (dired-face-marked ((t (:foreground "light salmon")))) (dired-face-executable ((t (:foreground "green yellow")))) (fringe ((t (:background "darkslategrey")))) (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) (highline-face ((t (:background "SeaGreen")))) (holiday-face ((t (:background "DimGray")))) (hyper-apropos-hyperlink ((t (:bold t :foreground "DodgerBlue1")))) (hyper-apropos-documentation ((t (:foreground "LightSalmon")))) (info-header-xref ((t (:foreground "DodgerBlue1" :bold t)))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:underline t :bold t :foreground "DodgerBlue1")))) (info-xref ((t (:bold t :foreground "DodgerBlue1")))) (isearch ((t (:background "sea green")))) (italic ((t (:italic t)))) (menu ((t (:foreground "wheat" :background "darkslategrey")))) (modeline ((t (:background "dark olive green" :foreground "wheat")))) (modeline-buffer-id ((t (:background "dark olive green" :foreground "beige")))) (modeline-mousable ((t (:background "dark olive green" :foreground "yellow green")))) (modeline-mousable-minor-mode ((t (:background "dark olive green" :foreground "wheat")))) (region ((t (:background "dark cyan" :foreground "cyan")))) (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) (show-paren-match-face ((t (:bold t :background "Aquamarine" :foreground "steel blue")))) (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) (underline ((t (:underline t)))) (widget-field-face ((t (:foreground "LightBlue")))) (widget-inactive-face ((t (:foreground "DimGray")))) (widget-single-line-field-face ((t (:foreground "LightBlue")))) (w3m-anchor-face ((t (:bold t :foreground "DodgerBlue1")))) (w3m-arrived-anchor-face ((t (:bold t :foreground "DodgerBlue3")))) (w3m-header-line-location-title-face ((t (:foreground "beige" :background "dark olive green")))) (w3m-header-line-location-content-face ((t (:foreground "wheat" :background "dark olive green")))) (woman-bold-face ((t (:bold t)))) (woman-italic-face ((t (:foreground "beige")))) (woman-unknown-face ((t (:foreground "LightSalmon")))) (zmacs-region ((t (:background "dark cyan" :foreground "cyan")))))))) (defun color-theme-simple-1 () "Black background. Doesn't mess with most faces, but does turn on dark background mode." (interactive) (color-theme-install '(color-theme-simple-1 ((foreground-color . "white") (background-color . "black") (cursor-color . "indian red") (background-mode . dark)) (default ((t (nil)))) (modeline ((t (:foreground "black" :background "white")))) (modeline-buffer-id ((t (:foreground "black" :background "white")))) (modeline-mousable ((t (:foreground "black" :background "white")))) (modeline-mousable-minor-mode ((t (:foreground "black" :background "white")))) (underline ((t (:underline t)))) (region ((t (:background "grey"))))))) (defun color-theme-jonadabian () "Dark blue background. Supports standard faces, font-lock, highlight-changes, widget and custom." (interactive) (color-theme-install '(color-theme-jonadabian ((foreground-color . "#CCBB77") (cursor-color . "medium turquoise") (background-color . "#000055") (background-mode . dark)) (default ((t (nil)))) (modeline ((t (:foreground "cyan" :background "#007080")))) (modeline-buffer-id ((t (:foreground "cyan" :background "#007080")))) (modeline-mousable ((t (:foreground "cyan" :background "#007080")))) (modeline-mousable-minor-mode ((t (:foreground "cyan" :background "#007080")))) (underline ((t (:underline t)))) (region ((t (:background "#004080")))) (font-lock-keyword-face ((t (:foreground "#00BBBB")))) (font-lock-comment-face ((t (:foreground "grey50" :bold t :italic t)))) (font-lock-string-face ((t (:foreground "#10D010")))) (font-lock-constant-face ((t (:foreground "indian red")))) (highlight-changes-face ((t (:background "navy")))) (highlight-changes-delete-face ((t (:foreground "red" :background "navy")))) (widget-field-face ((t (:foreground "black" :background "grey35")))) (widget-inactive-face ((t (:foreground "gray")))) (custom-button-face ((t (:foreground "yellow" :background "dark blue")))) (custom-state-face ((t (:foreground "mediumaquamarine")))) (custom-face-tag-face ((t (:foreground "goldenrod" :underline t)))) (custom-documentation-face ((t (:foreground "#10D010")))) (custom-set-face ((t (:foreground "#2020D0"))))))) (defun color-theme-ryerson () "White on midnightblue scheme. Used at Ryerson Polytechnic University in the Electronic Engineering department." (interactive) (color-theme-install '(color-theme-ryerson ((foreground-color . "white") (background-color . "midnightblue") (cursor-color . "red") (background-mode . dark)) (default ((t (nil)))) (modeline ((t (:foreground "black" :background "slategray3")))) (modeline-buffer-id ((t (:foreground "black" :background "slategray3")))) (modeline-mousable ((t (:foreground "black" :background "slategray3")))) (modeline-mousable-minor-mode ((t (:foreground "black" :background "slategray3")))) (underline ((t (:underline t)))) (region ((t (:foreground "black" :background "slategray3"))))))) (defun color-theme-wheat () "Default colors on a wheat background. Calls the standard color theme function `color-theme-standard' in order to reset all faces." (interactive) (color-theme-standard) (let ((color-theme-is-cumulative t)) (color-theme-install '(color-theme-wheat ((background-color . "Wheat")))))) (defun color-theme-standard () "Emacs default colors. If you are missing standard faces in this theme, please notify the maintainer." (interactive) ;; Note that some of the things that make up a color theme are ;; actually variable settings! (color-theme-install '(color-theme-standard ((foreground-color . "black") (background-color . "white") (mouse-color . "black") (cursor-color . "black") (border-color . "black") (background-mode . light)) ((Man-overstrike-face . bold) (Man-underline-face . underline) (apropos-keybinding-face . underline) (apropos-label-face . italic) (apropos-match-face . secondary-selection) (apropos-property-face . bold-italic) (apropos-symbol-face . bold) (goto-address-mail-face . italic) (goto-address-mail-mouse-face . secondary-selection) (goto-address-url-face . bold) (goto-address-url-mouse-face . highlight) (help-highlight-face . underline) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (default ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:bold t :italic t)))) (calendar-today-face ((t (:underline t)))) (cperl-array-face ((t (:foreground "Blue" :background "lightyellow2" :bold t)))) (cperl-hash-face ((t (:foreground "Red" :background "lightyellow2" :bold t :italic t)))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (custom-button-face ((t (nil)))) (custom-changed-face ((t (:foreground "white" :background "blue")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:foreground "blue" :underline t)))) (custom-group-tag-face-1 ((t (:foreground "red" :underline t)))) (custom-invalid-face ((t (:foreground "yellow" :background "red")))) (custom-modified-face ((t (:foreground "white" :background "blue")))) (custom-rogue-face ((t (:foreground "pink" :background "black")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:foreground "blue" :background "white")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:bold t :underline t)))) (custom-variable-tag-face ((t (:foreground "blue" :underline t)))) (diary-face ((t (:foreground "red")))) (ediff-current-diff-face-A ((t (:foreground "firebrick" :background "pale green")))) (ediff-current-diff-face-Ancestor ((t (:foreground "Black" :background "VioletRed")))) (ediff-current-diff-face-B ((t (:foreground "DarkOrchid" :background "Yellow")))) (ediff-current-diff-face-C ((t (:foreground "Navy" :background "Pink")))) (ediff-even-diff-face-A ((t (:foreground "Black" :background "light grey")))) (ediff-even-diff-face-Ancestor ((t (:foreground "White" :background "Grey")))) (ediff-even-diff-face-B ((t (:foreground "White" :background "Grey")))) (ediff-even-diff-face-C ((t (:foreground "Black" :background "light grey")))) (ediff-fine-diff-face-A ((t (:foreground "Navy" :background "sky blue")))) (ediff-fine-diff-face-Ancestor ((t (:foreground "Black" :background "Green")))) (ediff-fine-diff-face-B ((t (:foreground "Black" :background "cyan")))) (ediff-fine-diff-face-C ((t (:foreground "Black" :background "Turquoise")))) (ediff-odd-diff-face-A ((t (:foreground "White" :background "Grey")))) (ediff-odd-diff-face-Ancestor ((t (:foreground "Black" :background "light grey")))) (ediff-odd-diff-face-B ((t (:foreground "Black" :background "light grey")))) (ediff-odd-diff-face-C ((t (:foreground "White" :background "Grey")))) (eshell-ls-archive-face ((t (:foreground "Orchid" :bold t)))) (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) (eshell-ls-clutter-face ((t (:foreground "OrangeRed" :bold t)))) (eshell-ls-directory-face ((t (:foreground "Blue" :bold t)))) (eshell-ls-executable-face ((t (:foreground "ForestGreen" :bold t)))) (eshell-ls-missing-face ((t (:foreground "Red" :bold t)))) (eshell-ls-product-face ((t (:foreground "OrangeRed")))) (eshell-ls-readonly-face ((t (:foreground "Brown")))) (eshell-ls-special-face ((t (:foreground "Magenta" :bold t)))) (eshell-ls-symlink-face ((t (:foreground "DarkCyan" :bold t)))) (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) (eshell-prompt-face ((t (:foreground "Red" :bold t)))) (eshell-test-failed-face ((t (:foreground "OrangeRed" :bold t)))) (eshell-test-ok-face ((t (:foreground "Green" :bold t)))) (excerpt ((t (:italic t)))) (fixed ((t (:bold t)))) (flyspell-duplicate-face ((t (:foreground "Gold3" :bold t :underline t)))) (flyspell-incorrect-face ((t (:foreground "OrangeRed" :bold t :underline t)))) (font-lock-builtin-face ((t (:foreground "Orchid")))) (font-lock-comment-face ((t (:foreground "Firebrick")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-function-name-face ((t (:foreground "Blue")))) (font-lock-keyword-face ((t (:foreground "Purple")))) (font-lock-string-face ((t (:foreground "RosyBrown")))) (font-lock-type-face ((t (:foreground "ForestGreen")))) (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) (font-lock-warning-face ((t (:foreground "Red" :bold t)))) (fringe ((t (:background "grey95")))) (gnus-cite-attribution-face ((t (:italic t)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) (gnus-emphasis-underline-bold-italic ((t (:bold t :italic t :underline t)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:foreground "DeepPink3" :bold t)))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:foreground "HotPink3" :bold t)))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:foreground "magenta4" :bold t)))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:foreground "DeepPink4" :bold t)))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:foreground "ForestGreen" :bold t)))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:foreground "CadetBlue4" :bold t)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:foreground "DarkGreen" :bold t)))) (gnus-header-content-face ((t (:foreground "indianred4" :italic t)))) (gnus-header-from-face ((t (:foreground "red3")))) (gnus-header-name-face ((t (:foreground "maroon")))) (gnus-header-newsgroups-face ((t (:foreground "MidnightBlue" :italic t)))) (gnus-header-subject-face ((t (:foreground "red4")))) (gnus-signature-face ((t (:italic t)))) (gnus-splash-face ((t (:foreground "ForestGreen")))) (gnus-summary-cancelled-face ((t (:foreground "yellow" :background "black")))) (gnus-summary-high-ancient-face ((t (:foreground "RoyalBlue" :bold t)))) (gnus-summary-high-read-face ((t (:foreground "DarkGreen" :bold t)))) (gnus-summary-high-ticked-face ((t (:foreground "firebrick" :bold t)))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue" :italic t)))) (gnus-summary-low-read-face ((t (:foreground "DarkGreen" :italic t)))) (gnus-summary-low-ticked-face ((t (:foreground "firebrick" :italic t)))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (highlight ((t (:background "darkseagreen2")))) (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) (highlight-changes-face ((t (:foreground "red")))) (highline-face ((t (:background "paleturquoise")))) (holiday-face ((t (:background "pink")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:bold t :italic t)))) (info-xref ((t (:bold t)))) (italic ((t (:italic t)))) (makefile-space-face ((t (:background "hotpink")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:foreground "blue4" :bold t :italic t)))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:foreground "navy blue" :bold t)))) (message-header-to-face ((t (:foreground "MidnightBlue" :bold t)))) (message-header-xheader-face ((t (:foreground "blue")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:foreground "white" :background "black")))) (modeline-buffer-id ((t (:foreground "white" :background "black")))) (modeline-mousable ((t (:foreground "white" :background "black")))) (modeline-mousable-minor-mode ((t (:foreground "white" :background "black")))) (region ((t (:background "gray")))) (secondary-selection ((t (:background "paleturquoise")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:foreground "white" :background "purple")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-tag-face ((t (:foreground "brown")))) (term-black ((t (:foreground "black")))) (term-blackbg ((t (:background "black")))) (term-blue ((t (:foreground "blue")))) (term-bluebg ((t (:background "blue")))) (term-bold ((t (:bold t)))) (term-cyan ((t (:foreground "cyan")))) (term-cyanbg ((t (:background "cyan")))) (term-default-bg ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-default-fg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-green ((t (:foreground "green")))) (term-greenbg ((t (:background "green")))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-magenta ((t (:foreground "magenta")))) (term-magentabg ((t (:background "magenta")))) (term-red ((t (:foreground "red")))) (term-redbg ((t (:background "red")))) (term-underline ((t (:underline t)))) (term-white ((t (:foreground "white")))) (term-whitebg ((t (:background "white")))) (term-yellow ((t (:foreground "yellow")))) (term-yellowbg ((t (:background "yellow")))) (underline ((t (:underline t)))) (vcursor ((t (:foreground "blue" :background "cyan" :underline t)))) (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) (vhdl-font-lock-prompt-face ((t (:foreground "Red" :bold t)))) (vhdl-font-lock-reserved-words-face ((t (:foreground "Orange" :bold t)))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) (viper-minibuffer-emacs-face ((t (:foreground "Black" :background "darkseagreen2")))) (viper-minibuffer-insert-face ((t (:foreground "Black" :background "pink")))) (viper-minibuffer-vi-face ((t (:foreground "DarkGreen" :background "grey")))) (viper-replace-overlay-face ((t (:foreground "Black" :background "darkseagreen2")))) (viper-search-face ((t (:foreground "Black" :background "khaki")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85"))))))) (defun color-theme-fischmeister () "The light colors on a grey blackground. Sebastian Fischmeister " (interactive) (color-theme-install '(color-theme-fischmeister ((foreground-color . "black") (background-color . "gray80") (mouse-color . "red") (cursor-color . "yellow") (border-color . "black") (background-mode . light)) (default ((t (nil)))) (modeline ((t (:foreground "gray80" :background "black")))) (modeline-buffer-id ((t (:foreground "gray80" :background "black")))) (modeline-mousable ((t (:foreground "gray80" :background "black")))) (modeline-mousable-minor-mode ((t (:foreground "gray80" :background "black")))) (highlight ((t (:background "darkseagreen2")))) (bold ((t (:bold t)))) (italic ((t (:italic t)))) (bold-italic ((t (:bold t :italic t)))) (region ((t (:background "gray")))) (secondary-selection ((t (:background "paleturquoise")))) (underline ((t (:underline t)))) (show-paren-match-face ((t (:foreground "yellow" :background "darkgreen")))) (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) (font-lock-comment-face ((t (:foreground "FireBrick" :bold t :italic t)))) (font-lock-string-face ((t (:foreground "DarkSlateBlue" :italic t)))) (font-lock-keyword-face ((t (:foreground "navy")))) (font-lock-builtin-face ((t (:foreground "white")))) (font-lock-function-name-face ((t (:foreground "Blue")))) (font-lock-variable-name-face ((t (:foreground "Darkblue")))) (font-lock-type-face ((t (:foreground "darkgreen")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-warning-face ((t (:foreground "Orchid" :bold t)))) (font-lock-reference-face ((t (:foreground "SteelBlue"))))))) (defun color-theme-sitaramv-solaris () "White on a midnight blue background. Lots of yellow and orange. Includes faces for font-lock, widget, custom, speedbar, message, gnus, eshell." (interactive) (color-theme-install '(color-theme-sitaramv-solaris ((foreground-color . "white") (background-color . "MidnightBlue") (mouse-color . "yellow") (cursor-color . "magenta2") (border-color . "black") (background-mode . dark)) (default ((t (nil)))) (modeline ((t (:foreground "black" :background "gold2")))) (modeline-buffer-id ((t (:foreground "black" :background "gold2")))) (modeline-mousable ((t (:foreground "black" :background "gold2")))) (modeline-mousable-minor-mode ((t (:foreground "black" :background "gold2")))) (highlight ((t (:foreground "black" :background "Aquamarine")))) (bold ((t (:bold t)))) (italic ((t (:italic t)))) (bold-italic ((t (:bold t :italic t)))) (region ((t (:foreground "black" :background "snow3")))) (secondary-selection ((t (:foreground "black" :background "aquamarine")))) (underline ((t (:underline t)))) (lazy-highlight-face ((t (:foreground "yellow")))) (font-lock-comment-face ((t (:foreground "orange" :italic t)))) (font-lock-string-face ((t (:foreground "orange")))) (font-lock-keyword-face ((t (:foreground "green")))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-function-name-face ((t (:foreground "cyan" :bold t)))) (font-lock-variable-name-face ((t (:foreground "white")))) (font-lock-type-face ((t (:foreground "cyan")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-warning-face ((t (:foreground "Pink" :bold t)))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-button-face ((t (:bold t)))) (widget-field-face ((t (:background "dim gray")))) (widget-single-line-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-button-pressed-face ((t (:foreground "red")))) (custom-invalid-face ((t (:foreground "yellow" :background "red")))) (custom-rogue-face ((t (:foreground "pink" :background "black")))) (custom-modified-face ((t (:foreground "white" :background "blue")))) (custom-set-face ((t (:foreground "blue" :background "white")))) (custom-changed-face ((t (:foreground "white" :background "blue")))) (custom-saved-face ((t (:underline t)))) (custom-button-face ((t (nil)))) (custom-documentation-face ((t (nil)))) (custom-state-face ((t (:foreground "lime green")))) (custom-variable-tag-face ((t (:foreground "light blue" :underline t)))) (custom-variable-button-face ((t (:bold t :underline t)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face-1 ((t (:foreground "pink" :underline t)))) (custom-group-tag-face ((t (:foreground "light blue" :underline t)))) (speedbar-button-face ((t (:foreground "green3")))) (speedbar-file-face ((t (:foreground "cyan")))) (speedbar-directory-face ((t (:foreground "light blue")))) (speedbar-tag-face ((t (:foreground "yellow")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-highlight-face ((t (:background "sea green")))) (font-lock-doc-string-face ((t (:foreground "Plum1" :bold t)))) (font-lock-exit-face ((t (:foreground "green")))) (ff-paths-non-existant-file-face ((t (:foreground "NavyBlue" :bold t)))) (show-paren-match-face ((t (:background "red")))) (show-paren-mismatch-face ((t (:foreground "white" :background "purple")))) (message-header-to-face ((t (:foreground "green2" :bold t)))) (message-header-cc-face ((t (:foreground "LightGoldenrod" :bold t)))) (message-header-subject-face ((t (:foreground "green3")))) (message-header-newsgroups-face ((t (:foreground "yellow" :bold t :italic t)))) (message-header-other-face ((t (:foreground "Salmon")))) (message-header-name-face ((t (:foreground "green3")))) (message-header-xheader-face ((t (:foreground "GreenYellow")))) (message-separator-face ((t (:foreground "Tan")))) (message-cited-text-face ((t (:foreground "Gold")))) (message-mml-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:foreground "PaleTurquoise" :bold t)))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-2-face ((t (:foreground "turquoise" :bold t)))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-low-face ((t (:foreground "DarkTurquoise" :bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-mail-1-face ((t (:foreground "aquamarine1" :bold t)))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-2-face ((t (:foreground "aquamarine2" :bold t)))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-3-face ((t (:foreground "aquamarine3" :bold t)))) (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) (gnus-group-mail-low-face ((t (:foreground "aquamarine4" :bold t)))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-summary-selected-face ((t (:underline t)))) (gnus-summary-cancelled-face ((t (:foreground "yellow" :background "black")))) (gnus-summary-high-ticked-face ((t (:foreground "pink" :bold t)))) (gnus-summary-low-ticked-face ((t (:foreground "pink" :italic t)))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-high-ancient-face ((t (:foreground "SkyBlue" :bold t)))) (gnus-summary-low-ancient-face ((t (:foreground "SkyBlue" :italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-high-read-face ((t (:foreground "PaleGreen" :bold t)))) (gnus-summary-low-read-face ((t (:foreground "PaleGreen" :italic t)))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-splash-face ((t (:foreground "Brown")))) (eshell-ls-directory-face ((t (:foreground "SkyBlue" :bold t)))) (eshell-ls-symlink-face ((t (:foreground "Cyan" :bold t)))) (eshell-ls-executable-face ((t (:foreground "Green" :bold t)))) (eshell-ls-readonly-face ((t (:foreground "Pink")))) (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) (eshell-ls-special-face ((t (:foreground "Magenta" :bold t)))) (eshell-ls-missing-face ((t (:foreground "Red" :bold t)))) (eshell-ls-archive-face ((t (:foreground "Orchid" :bold t)))) (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) (eshell-ls-product-face ((t (:foreground "LightSalmon")))) (eshell-ls-clutter-face ((t (:foreground "OrangeRed" :bold t)))) (eshell-prompt-face ((t (:foreground "Pink" :bold t)))) (term-default-fg ((t (nil)))) (term-default-bg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-bold ((t (:bold t)))) (term-underline ((t (:underline t)))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-black ((t (:foreground "black")))) (term-red ((t (:foreground "red")))) (term-green ((t (:foreground "green")))) (term-yellow ((t (:foreground "yellow")))) (term-blue ((t (:foreground "blue")))) (term-magenta ((t (:foreground "magenta")))) (term-cyan ((t (:foreground "cyan")))) (term-white ((t (:foreground "white")))) (term-blackbg ((t (:background "black")))) (term-redbg ((t (:background "red")))) (term-greenbg ((t (:background "green")))) (term-yellowbg ((t (:background "yellow")))) (term-bluebg ((t (:background "blue")))) (term-magentabg ((t (:background "magenta")))) (term-cyanbg ((t (:background "cyan")))) (term-whitebg ((t (:background "white")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) (gnus-emphasis-underline-bold-italic ((t (:bold t :italic t :underline t)))) (gnus-emphasis-highlight-words ((t (:foreground "yellow" :background "black")))) (gnus-signature-face ((t (:italic t)))) (gnus-header-from-face ((t (:foreground "spring green")))) (gnus-header-subject-face ((t (:foreground "yellow" :bold t)))) (gnus-header-newsgroups-face ((t (:foreground "SeaGreen3" :bold t :italic t)))) (gnus-header-name-face ((t (:foreground "pink")))) (gnus-header-content-face ((t (:foreground "lime green" :italic t)))) (gnus-cite-attribution-face ((t (:italic t)))) (gnus-cite-face-1 ((t (:foreground "light blue")))) (gnus-cite-face-2 ((t (:foreground "light cyan")))) (gnus-cite-face-3 ((t (:foreground "light yellow")))) (gnus-cite-face-4 ((t (:foreground "light pink")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:foreground "beige")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise"))))))) (defun color-theme-sitaramv-nt () "Black foreground on white background. Includes faces for font-lock, widget, custom, speedbar." (interactive) (color-theme-install '(color-theme-sitaramv-nt ((foreground-color . "black") (background-color . "white") (mouse-color . "sienna3") (cursor-color . "HotPink") (border-color . "Blue") (background-mode . light)) (default ((t (nil)))) (modeline ((t (:foreground "black" :background "gold2")))) (modeline-buffer-id ((t (:foreground "black" :background "gold2")))) (modeline-mousable ((t (:foreground "black" :background "gold2")))) (modeline-mousable-minor-mode ((t (:foreground "black" :background "gold2")))) (highlight ((t (:foreground "black" :background "darkseagreen2")))) (bold ((t (:bold t)))) (italic ((t (:italic t)))) (bold-italic ((t (:bold t :italic t)))) (region ((t (:foreground "black" :background "snow3")))) (secondary-selection ((t (:background "paleturquoise")))) (underline ((t (:underline t)))) (lazy-highlight-face ((t (:foreground "dark magenta" :bold t)))) (font-lock-comment-face ((t (:foreground "ForestGreen" :italic t)))) (font-lock-string-face ((t (:foreground "red")))) (font-lock-keyword-face ((t (:foreground "blue" :bold t)))) (font-lock-builtin-face ((t (:foreground "black")))) (font-lock-function-name-face ((t (:foreground "dark magenta" :bold t)))) (font-lock-variable-name-face ((t (:foreground "black")))) (font-lock-type-face ((t (:foreground "blue")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-warning-face ((t (:foreground "Red" :bold t)))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-button-face ((t (:bold t)))) (widget-field-face ((t (:background "gray85")))) (widget-single-line-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-button-pressed-face ((t (:foreground "red")))) (custom-invalid-face ((t (:foreground "yellow" :background "red")))) (custom-rogue-face ((t (:foreground "pink" :background "black")))) (custom-modified-face ((t (:foreground "white" :background "blue")))) (custom-set-face ((t (:foreground "blue" :background "white")))) (custom-changed-face ((t (:foreground "white" :background "blue")))) (custom-saved-face ((t (:underline t)))) (custom-button-face ((t (nil)))) (custom-documentation-face ((t (nil)))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-tag-face ((t (:foreground "blue" :underline t)))) (custom-variable-button-face ((t (:bold t :underline t)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face-1 ((t (:foreground "red" :underline t)))) (custom-group-tag-face ((t (:foreground "blue" :underline t)))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-tag-face ((t (:foreground "brown")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-highlight-face ((t (:background "green")))) (ff-paths-non-existant-file-face ((t (:foreground "NavyBlue" :bold t)))) (show-paren-match-face ((t (:background "light blue")))) (show-paren-mismatch-face ((t (:foreground "white" :background "purple"))))))) (defun color-theme-billw () "Cornsilk on black. Includes info, diary, font-lock, eshell, sgml, message, gnus, widget, custom, latex, ediff." (interactive) (color-theme-install '(color-theme-billw ((foreground-color . "cornsilk") (background-color . "black") (mouse-color . "black") (cursor-color . "white") (border-color . "black") (background-mode . dark)) (default ((t (nil)))) (modeline ((t (:foreground "black" :background "wheat")))) (modeline-buffer-id ((t (:foreground "black" :background "wheat")))) (modeline-mousable ((t (:foreground "black" :background "wheat")))) (modeline-mousable-minor-mode ((t (:foreground "black" :background "wheat")))) (highlight ((t (:foreground "wheat" :background "darkslategray")))) (bold ((t (:bold t)))) (italic ((t (:italic t)))) (bold-italic ((t (:bold t :italic t)))) (region ((t (:background "dimgray")))) (secondary-selection ((t (:background "deepskyblue4")))) (underline ((t (:underline t)))) (info-node ((t (:foreground "yellow" :bold t :italic t)))) (info-menu-5 ((t (:underline t)))) (info-xref ((t (:foreground "yellow" :bold t)))) (diary-face ((t (:foreground "orange")))) (calendar-today-face ((t (:underline t)))) (holiday-face ((t (:background "red")))) (show-paren-match-face ((t (:background "deepskyblue4")))) (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) (font-lock-comment-face ((t (:foreground "gold")))) (font-lock-string-face ((t (:foreground "orange")))) (font-lock-keyword-face ((t (:foreground "cyan1")))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-function-name-face ((t (:foreground "mediumspringgreen")))) (font-lock-variable-name-face ((t (:foreground "light salmon")))) (font-lock-type-face ((t (:foreground "yellow1")))) (font-lock-constant-face ((t (:foreground "salmon")))) (font-lock-warning-face ((t (:foreground "gold" :bold t)))) (blank-space-face ((t (:background "LightGray")))) (blank-tab-face ((t (:foreground "black" :background "cornsilk")))) (highline-face ((t (:background "gray35")))) (eshell-ls-directory-face ((t (:foreground "green" :bold t)))) (eshell-ls-symlink-face ((t (:foreground "Cyan" :bold t)))) (eshell-ls-executable-face ((t (:foreground "orange" :bold t)))) (eshell-ls-readonly-face ((t (:foreground "gray")))) (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) (eshell-ls-special-face ((t (:foreground "Magenta" :bold t)))) (eshell-ls-missing-face ((t (:foreground "Red" :bold t)))) (eshell-ls-archive-face ((t (:foreground "Orchid" :bold t)))) (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) (eshell-ls-product-face ((t (:foreground "LightSalmon")))) (eshell-ls-clutter-face ((t (:foreground "blue" :bold t)))) (sgml-start-tag-face ((t (:foreground "mediumspringgreen")))) (custom-button-face ((t (:foreground "white")))) (sgml-ignored-face ((t (:foreground "gray20" :background "gray60")))) (sgml-doctype-face ((t (:foreground "orange")))) (sgml-sgml-face ((t (:foreground "yellow")))) (vc-annotate-face-0046FF ((t (:foreground "wheat" :background "black")))) (custom-documentation-face ((t (:foreground "white")))) (sgml-end-tag-face ((t (:foreground "greenyellow")))) (linemenu-face ((t (:background "gray30")))) (sgml-entity-face ((t (:foreground "gold")))) (message-header-to-face ((t (:foreground "floral white" :bold t)))) (message-header-cc-face ((t (:foreground "ivory")))) (message-header-subject-face ((t (:foreground "papaya whip" :bold t)))) (message-header-newsgroups-face ((t (:foreground "lavender blush" :bold t :italic t)))) (message-header-other-face ((t (:foreground "pale turquoise")))) (message-header-name-face ((t (:foreground "light sky blue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-separator-face ((t (:foreground "sandy brown")))) (message-cited-text-face ((t (:foreground "plum1")))) (message-mml-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:foreground "white" :bold t)))) (gnus-group-news-1-empty-face ((t (:foreground "white")))) (gnus-group-news-2-face ((t (:foreground "lightcyan" :bold t)))) (gnus-group-news-2-empty-face ((t (:foreground "lightcyan")))) (gnus-group-news-3-face ((t (:foreground "tan" :bold t)))) (gnus-group-news-3-empty-face ((t (:foreground "tan")))) (gnus-group-news-4-face ((t (:foreground "white" :bold t)))) (gnus-group-news-4-empty-face ((t (:foreground "white")))) (gnus-group-news-5-face ((t (:foreground "wheat" :bold t)))) (gnus-group-news-5-empty-face ((t (:foreground "wheat")))) (gnus-group-news-6-face ((t (:foreground "tan" :bold t)))) (gnus-group-news-6-empty-face ((t (:foreground "tan")))) (gnus-group-news-low-face ((t (:foreground "DarkTurquoise" :bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-mail-1-face ((t (:foreground "white" :bold t)))) (gnus-group-mail-1-empty-face ((t (:foreground "gray80")))) (gnus-group-mail-2-face ((t (:foreground "lightcyan" :bold t)))) (gnus-group-mail-2-empty-face ((t (:foreground "lightcyan")))) (gnus-group-mail-3-face ((t (:foreground "tan" :bold t)))) (gnus-group-mail-3-empty-face ((t (:foreground "tan")))) (gnus-group-mail-low-face ((t (:foreground "aquamarine4" :bold t)))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-summary-selected-face ((t (:background "deepskyblue4" :underline t)))) (gnus-summary-cancelled-face ((t (:foreground "black" :background "gray")))) (gnus-summary-high-ticked-face ((t (:foreground "gray70" :bold t)))) (gnus-summary-low-ticked-face ((t (:foreground "gray70" :bold t)))) (gnus-summary-normal-ticked-face ((t (:foreground "gray70" :bold t)))) (gnus-summary-high-ancient-face ((t (:foreground "SkyBlue" :bold t)))) (gnus-summary-low-ancient-face ((t (:foreground "SkyBlue" :italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-high-read-face ((t (:foreground "PaleGreen" :bold t)))) (gnus-summary-low-read-face ((t (:foreground "PaleGreen" :italic t)))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-splash-face ((t (:foreground "gold")))) (font-latex-bold-face ((t (nil)))) (font-latex-italic-face ((t (nil)))) (font-latex-math-face ((t (nil)))) (font-latex-sedate-face ((t (:foreground "Gray85")))) (font-latex-string-face ((t (:foreground "orange")))) (font-latex-warning-face ((t (:foreground "gold")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-button-face ((t (:bold t)))) (widget-field-face ((t (:background "gray20")))) (widget-single-line-field-face ((t (:background "gray20")))) (widget-inactive-face ((t (:foreground "wheat")))) (widget-button-pressed-face ((t (:foreground "red")))) (custom-invalid-face ((t (:foreground "yellow" :background "red")))) (custom-rogue-face ((t (:foreground "pink" :background "black")))) (custom-modified-face ((t (:foreground "white" :background "blue")))) (custom-set-face ((t (:foreground "blue")))) (custom-changed-face ((t (:foreground "wheat" :background "skyblue")))) (custom-saved-face ((t (:underline t)))) (custom-state-face ((t (:foreground "light green")))) (custom-variable-tag-face ((t (:foreground "skyblue" :underline t)))) (custom-variable-button-face ((t (:bold t :underline t)))) (custom-face-tag-face ((t (:foreground "white" :underline t)))) (custom-group-tag-face-1 ((t (:foreground "pink" :underline t)))) (custom-group-tag-face ((t (:foreground "skyblue" :underline t)))) (swbuff-current-buffer-face ((t (:foreground "red" :bold t)))) (ediff-current-diff-face-A ((t (:foreground "firebrick" :background "pale green")))) (ediff-current-diff-face-B ((t (:foreground "DarkOrchid" :background "Yellow")))) (ediff-current-diff-face-C ((t (:foreground "white" :background "indianred")))) (ediff-current-diff-face-Ancestor ((t (:foreground "Black" :background "VioletRed")))) (ediff-fine-diff-face-A ((t (:foreground "Navy" :background "sky blue")))) (ediff-fine-diff-face-B ((t (:foreground "Black" :background "cyan")))) (ediff-fine-diff-face-C ((t (:foreground "Black" :background "Turquoise")))) (ediff-fine-diff-face-Ancestor ((t (:foreground "Black" :background "Green")))) (ediff-even-diff-face-A ((t (:foreground "Black" :background "light grey")))) (ediff-even-diff-face-B ((t (:foreground "White" :background "Grey")))) (ediff-even-diff-face-C ((t (:foreground "Black" :background "light grey")))) (ediff-even-diff-face-Ancestor ((t (:foreground "White" :background "Grey")))) (ediff-odd-diff-face-A ((t (:foreground "White" :background "Grey")))) (ediff-odd-diff-face-B ((t (:foreground "Black" :background "light grey")))) (ediff-odd-diff-face-C ((t (:foreground "White" :background "Grey")))) (ediff-odd-diff-face-Ancestor ((t (:foreground "Black" :background "light grey")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:foreground "white" :background "goldenrod4")))) (gnus-emphasis-underline-bold ((t (:foreground "black" :background "yellow" :bold t :underline t)))) (gnus-emphasis-underline-italic ((t (:foreground "black" :background "yellow" :italic t :underline t)))) (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) (gnus-emphasis-underline-bold-italic ((t (:foreground "black" :background "yellow" :bold t :italic t :underline t)))) (gnus-emphasis-highlight-words ((t (:foreground "yellow" :background "black")))) (gnus-signature-face ((t (:italic t)))) (gnus-header-from-face ((t (:foreground "wheat")))) (gnus-header-subject-face ((t (:foreground "wheat" :bold t)))) (gnus-header-newsgroups-face ((t (:foreground "wheat" :italic t)))) (gnus-header-name-face ((t (:foreground "white")))) (gnus-header-content-face ((t (:foreground "tan" :italic t)))) (gnus-filterhist-face-1 ((t (nil)))) (gnus-splash ((t (:foreground "Brown")))) (gnus-cite-attribution-face ((t (:italic t)))) (gnus-cite-face-1 ((t (:foreground "light blue")))) (gnus-cite-face-2 ((t (:foreground "light cyan")))) (gnus-cite-face-3 ((t (:foreground "light yellow")))) (gnus-cite-face-4 ((t (:foreground "light pink")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:foreground "beige")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise"))))))) (defun color-theme-retro-green (&optional color func) "Plain green on black faces for those longing for the good old days." (interactive) ;; Build a list of faces without parameters (let ((old-faces (face-list)) (faces) (face) (foreground (or color "green"))) (dolist (face old-faces) (cond ((memq face '(bold bold-italic)) (add-to-list 'faces `(,face (( t (:bold t)))))) ((memq face '(italic underline show-paren-mismatch-face)) (add-to-list 'faces `(,face (( t (:underline t)))))) ((memq face '(modeline modeline-buffer-id modeline-mousable modeline-mousable-minor-mode highlight region secondary-selection show-paren-match-face)) (add-to-list 'faces `(,face (( t (:foreground "black" :background ,foreground :inverse t)))))) (t (add-to-list 'faces `(,face (( t (nil)))))))) (color-theme-install (append (list (or func 'color-theme-retro-green) (list (cons 'foreground-color foreground) (cons 'background-color "black") (cons 'mouse-color foreground) (cons 'cursor-color foreground) (cons 'border-color foreground) (cons 'background-mode 'dark))) faces)))) (defun color-theme-retro-orange () "Plain orange on black faces for those longing for the good old days." (interactive) (color-theme-retro-green "orange" 'color-theme-retro-orange)) (defun color-theme-subtle-hacker () "Subtle Hacker Color Theme. Based on gnome2, but uses white for important things like comments, and less of the unreadable tomato. By Colin Walters " (interactive) (color-theme-gnome2) (let ((color-theme-is-cumulative t)) (color-theme-install '(color-theme-subtle-hacker nil nil (custom-state-face ((t (:foreground "Coral")))) (diary-face ((t (:bold t :foreground "IndianRed")))) (eshell-ls-clutter-face ((t (:bold t :foreground "DimGray")))) (eshell-ls-executable-face ((t (:bold t :foreground "Coral")))) (eshell-ls-missing-face ((t (:bold t :foreground "black")))) (eshell-ls-special-face ((t (:bold t :foreground "Gold")))) (eshell-ls-symlink-face ((t (:bold t :foreground "White")))) (font-lock-comment-face ((t (:foreground "White")))) (font-lock-constant-face ((t (:bold t :foreground "Aquamarine")))) (font-lock-function-name-face ((t (:bold t :foreground "MediumSlateBlue")))) (font-lock-string-face ((t (:italic t :foreground "LightSalmon")))) (font-lock-variable-name-face ((t (:italic t :bold t :foreground "Aquamarine")))) (gnus-cite-face-1 ((t (:foreground "dark khaki")))) (gnus-cite-face-2 ((t (:foreground "chocolate")))) (gnus-cite-face-3 ((t (:foreground "tomato")))) (gnus-group-mail-1-empty-face ((t (:foreground "light cyan")))) (gnus-group-mail-1-face ((t (:bold t :foreground "light cyan")))) (gnus-group-mail-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-mail-2-face ((t (:bold t :foreground "turquoise")))) (gnus-group-mail-3-empty-face ((t (:foreground "tomato")))) (gnus-group-mail-3-face ((t (:bold t :foreground "tomato")))) (gnus-group-mail-low-empty-face ((t (:foreground "dodger blue")))) (gnus-group-mail-low-face ((t (:bold t :foreground "dodger blue")))) (gnus-group-news-1-empty-face ((t (:foreground "green yellow")))) (gnus-group-news-1-face ((t (:bold t :foreground "green yellow")))) (gnus-group-news-2-empty-face ((t (:foreground "dark orange")))) (gnus-group-news-2-face ((t (:bold t :foreground "dark orange")))) (gnus-group-news-3-empty-face ((t (:foreground "tomato")))) (gnus-group-news-3-face ((t (:bold t :foreground "tomato")))) (gnus-group-news-low-empty-face ((t (:foreground "yellow green")))) (gnus-group-news-low-face ((t (:bold t :foreground "yellow green")))) (gnus-header-name-face ((t (:bold t :foreground "DodgerBlue1")))) (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) (gnus-signature-face ((t (:foreground "salmon")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "forest green")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "burlywood")))) (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "cyan")))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "chocolate")))) (gnus-summary-low-read-face ((t (:foreground "light sea green")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "chocolate")))) (gnus-summary-low-unread-face ((t (:italic t :foreground "light sea green")))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "khaki")))) (gnus-summary-normal-ticked-face ((t (:foreground "sandy brown")))) (gnus-summary-normal-unread-face ((t (:foreground "aquamarine")))) (message-cited-text-face ((t (:foreground "White")))) (message-header-name-face ((t (:foreground "DodgerBlue1")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) (message-header-other-face ((t (:foreground "LightSkyBlue3")))) (message-header-xheader-face ((t (:foreground "DodgerBlue3")))))))) (defun color-theme-pok-wog () "Low-contrast White-on-Gray by S.Pokrovsky. The following might be a good addition to your .Xdefaults file: Emacs.pane.menubar.background: darkGrey Emacs.pane.menubar.foreground: black" (interactive) (color-theme-install '(color-theme-pok-wog ((foreground-color . "White") (background-color . "DarkSlateGray") (mouse-color . "gold") (cursor-color . "Cyan") (border-color . "black") (background-mode . dark)) (default ((t (nil)))) (bold ((t (:bold t :foreground "Wheat")))) (bold-italic ((t (:italic t :bold t :foreground "wheat")))) (calendar-today-face ((t (:underline t :foreground "white")))) (diary-face ((t (:foreground "red")))) (font-lock-builtin-face ((t (:bold t :foreground "cyan")))) (font-lock-comment-face ((t (:foreground "Gold")))) (font-lock-constant-face ((t (:bold t :foreground "LightSteelBlue")))) (font-lock-function-name-face ((t (:bold t :foreground "Yellow")))) (font-lock-keyword-face ((t (:bold t :foreground "Cyan")))) (font-lock-string-face ((t (:foreground "Khaki")))) (font-lock-type-face ((t (:bold t :foreground "Cyan")))) (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (gnus-cite-attribution-face ((t (:bold t :foreground "Wheat")))) (gnus-cite-face-1 ((t (:foreground "wheat")))) (gnus-cite-face-10 ((t (:foreground "wheat")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "cyan")))) (gnus-cite-face-3 ((t (:foreground "light yellow")))) (gnus-cite-face-4 ((t (:foreground "light pink")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:foreground "beige")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t :foreground "wheat")))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t :foreground "white")))) (gnus-emphasis-underline ((t (:underline t :foreground "white")))) (gnus-emphasis-underline-bold ((t (:underline t :bold t :foreground "wheat")))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t :foreground "white")))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) (gnus-group-mail-3-empty-face ((t (:foreground "Salmon")))) (gnus-group-mail-3-face ((t (:bold t :foreground "gold")))) (gnus-group-mail-low-empty-face ((t (:foreground "Wheat")))) (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t :foreground "Wheat")))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) (gnus-header-content-face ((t (:italic t :foreground "Wheat")))) (gnus-header-from-face ((t (:foreground "light yellow")))) (gnus-header-name-face ((t (:foreground "cyan")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow")))) (gnus-header-subject-face ((t (:bold t :foreground "Gold")))) (gnus-signature-face ((t (:italic t :foreground "wheat")))) (gnus-splash-face ((t (:foreground "orange")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) (gnus-summary-high-unread-face ((t (:bold t :foreground "gold")))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-normal-unread-face ((t (:foreground "wheat")))) (gnus-summary-selected-face ((t (:underline t :foreground "white")))) (highlight ((t (:background "Blue" :foreground "white")))) (highline-face ((t (:background "black" :foreground "white")))) (holiday-face ((t (:background "pink" :foreground "white")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:italic t :bold t :foreground "white")))) (info-xref ((t (:bold t :foreground "wheat")))) (italic ((t (:italic t :foreground "white")))) (makefile-space-face ((t (:background "hotpink")))) (message-cited-text-face ((t (:foreground "green")))) (message-header-cc-face ((t (:bold t :foreground "Aquamarine")))) (message-header-name-face ((t (:foreground "Gold")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) (message-header-other-face ((t (:foreground "lightGray")))) (message-header-subject-face ((t (:foreground "Yellow")))) (message-header-to-face ((t (:bold t :foreground "green2")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:bold t :foreground "khaki")))) (message-separator-face ((t (:background "aquamarine" :foreground "black")))) (modeline ((t (:background "DarkGray" :foreground "Black")))) (modeline-buffer-id ((t (:background "DarkGray" :foreground "Black")))) (modeline-mousable ((t (:background "DarkGray" :foreground "Black")))) (modeline-mousable-minor-mode ((t (:background "DarkGray" :foreground "Black")))) (paren-mismatch-face ((t (:background "DeepPink" :foreground "white")))) (paren-no-match-face ((t (:background "yellow" :foreground "white")))) (region ((t (:background "MediumSlateBlue" :foreground "white")))) (secondary-selection ((t (:background "Sienna" :foreground "white")))) (show-paren-match-face ((t (:background "turquoise" :foreground "white")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (speedbar-button-face ((t (:bold t :foreground "magenta")))) (speedbar-directory-face ((t (:bold t :foreground "orchid")))) (speedbar-file-face ((t (:foreground "pink")))) (speedbar-highlight-face ((t (:background "black")))) (speedbar-selected-face ((t (:underline t :foreground "cyan")))) (speedbar-tag-face ((t (:foreground "yellow")))) (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) (underline ((t (:underline t :foreground "white")))) (widget-button-face ((t (:bold t :foreground "wheat")))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray" :foreground "white")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray" :foreground "white"))))))) (defun color-theme-pok-wob () "White-on-Black by S. Pokrovsky. The following might be a good addition to your .Xdefaults file: Emacs.pane.menubar.background: darkGrey Emacs.pane.menubar.foreground: black" (interactive) ; (setq term-default-fg-color "white" ; term-default-bg "black") (color-theme-install '(color-theme-pok-wob ((foreground-color . "white") (background-color . "black") (mouse-color . "gold") (cursor-color . "yellow") (border-color . "black") (background-mode . dark)) (default ((t (nil)))) (bold ((t (:bold t :foreground "light gray")))) (bold-italic ((t (:italic t :bold t :foreground "cyan")))) (calendar-today-face ((t (:underline t :foreground "white")))) (custom-button-face ((t (nil)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t)))) (custom-group-tag-face-1 ((t (:underline t)))) (custom-invalid-face ((t (:background "red" :foreground "white")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (nil)))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t)))) (diary-face ((t (:foreground "gold")))) (font-lock-builtin-face ((t (:bold t :foreground "cyan")))) (font-lock-comment-face ((t (:foreground "Gold")))) (font-lock-constant-face ((t (:bold t :foreground "LightSteelBlue")))) (font-lock-function-name-face ((t (:bold t :foreground "gold")))) (font-lock-keyword-face ((t (:bold t :foreground "Cyan")))) (font-lock-string-face ((t (:foreground "Khaki")))) (font-lock-type-face ((t (:bold t :foreground "Cyan")))) (font-lock-variable-name-face ((t (:italic t :foreground "gold")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (gnus-cite-attribution-face ((t (:underline t :foreground "beige")))) (gnus-cite-face-1 ((t (:foreground "gold")))) (gnus-cite-face-10 ((t (:foreground "coral")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "wheat")))) (gnus-cite-face-3 ((t (:foreground "light pink")))) (gnus-cite-face-4 ((t (:foreground "khaki")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:foreground "beige")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t :foreground "light gray")))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "cyan")))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "gold")))) (gnus-emphasis-italic ((t (:italic t :foreground "cyan")))) (gnus-emphasis-underline ((t (:underline t :foreground "white")))) (gnus-emphasis-underline-bold ((t (:underline t :bold t :foreground "white")))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t :foreground "white")))) (gnus-emphasis-underline-italic ((t (:underline t :italic t :foreground "white")))) (gnus-group-mail-1-empty-face ((t (:foreground "Magenta")))) (gnus-group-mail-1-face ((t (:bold t :foreground "Magenta")))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) (gnus-group-mail-3-empty-face ((t (:foreground "Cyan")))) (gnus-group-mail-3-face ((t (:bold t :foreground "Cyan")))) (gnus-group-mail-low-empty-face ((t (:foreground "Wheat")))) (gnus-group-mail-low-face ((t (:foreground "aquamarine4")))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) (gnus-group-news-3-empty-face ((t (:foreground "wheat")))) (gnus-group-news-3-face ((t (:bold t :foreground "Wheat")))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine")))) (gnus-header-content-face ((t (:italic t :foreground "Wheat")))) (gnus-header-from-face ((t (:foreground "light yellow")))) (gnus-header-name-face ((t (:foreground "Wheat")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "gold")))) (gnus-header-subject-face ((t (:bold t :foreground "Gold")))) (gnus-signature-face ((t (:italic t :foreground "white")))) (gnus-splash-face ((t (:foreground "orange")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "orange")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "red")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "coral")))) (gnus-summary-high-unread-face ((t (:bold t :foreground "gold")))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "red")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "coral")))) (gnus-summary-low-unread-face ((t (:italic t :foreground "white")))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-normal-unread-face ((t (:foreground "white")))) (gnus-summary-selected-face ((t (:underline t :foreground "white")))) (highlight ((t (:background "Blue" :foreground "white")))) (highline-face ((t (:background "dark slate gray" :foreground "white")))) (holiday-face ((t (:background "red" :foreground "white")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:italic t :bold t :foreground "white")))) (info-xref ((t (:bold t :foreground "light gray")))) (italic ((t (:italic t :foreground "cyan")))) (makefile-space-face ((t (:background "hotpink" :foreground "white")))) (message-cited-text-face ((t (:foreground "green")))) (message-header-cc-face ((t (:bold t :foreground "Aquamarine")))) (message-header-name-face ((t (:foreground "Gold")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "gold")))) (message-header-other-face ((t (:foreground "lightGray")))) (message-header-subject-face ((t (:foreground "Yellow")))) (message-header-to-face ((t (:bold t :foreground "green2")))) (message-header-xheader-face ((t (:foreground "sky blue")))) (message-mml-face ((t (:bold t :foreground "khaki")))) (message-separator-face ((t (:background "aquamarine" :foreground "black")))) (modeline ((t (:background "dark gray" :foreground "black")))) (modeline-buffer-id ((t (:background "dark gray" :foreground "black")))) (modeline-mousable ((t (:background "dark gray" :foreground "black")))) (modeline-mousable-minor-mode ((t (:background "dark gray" :foreground "black")))) (paren-mismatch-face ((t (:bold t :background "white" :foreground "red")))) (paren-no-match-face ((t (:bold t :background "white" :foreground "red")))) (region ((t (:background "MediumSlateBlue" :foreground "white")))) (secondary-selection ((t (:background "Sienna" :foreground "white")))) (show-paren-match-face ((t (:background "purple" :foreground "white")))) (show-paren-mismatch-face ((t (:bold t :background "white" :foreground "red")))) (speedbar-button-face ((t (nil)))) (speedbar-directory-face ((t (nil)))) (speedbar-file-face ((t (:bold t)))) (speedbar-highlight-face ((t (nil)))) (speedbar-selected-face ((t (:underline t)))) (speedbar-tag-face ((t (nil)))) (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) (underline ((t (:underline t :foreground "white")))) (widget-button-face ((t (:bold t :foreground "coral")))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray" :foreground "white")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray" :foreground "white"))))))) (defun color-theme-blue-sea () "The grey on midnight blue theme. Includes faces for apropos, font-lock (Emacs and XEmacs), speedbar, custom, widget, info, flyspell, gnus, message, man, woman, dired. This is what you should put in your .Xdefaults file, if you want to change the colors of the menus: emacs*Background: DarkSlateGray emacs*Foreground: Wheat" (interactive) (color-theme-blue-gnus) (let ((color-theme-is-cumulative t)) (color-theme-blue-erc) (color-theme-install '(color-theme-blue-sea ((background-color . "MidnightBlue") (background-mode . dark) (border-color . "Grey") (cursor-color . "Grey") (foreground-color . "Grey") (mouse-color . "Grey")) ((Man-overstrike-face . woman-bold-face) (Man-underline-face . woman-italic-face)) (default ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:bold t :foreground "beige")))) (calendar-today-face ((t (:underline t)))) (cperl-array-face ((t (:foreground "light salmon" :bold t)))) (cperl-hash-face ((t (:foreground "beige" :bold t :italic t)))) (cperl-nonoverridable-face ((t (:foreground "aquamarine")))) (custom-button-face ((t (:foreground "gainsboro")))) (custom-changed-face ((t (:foreground "white" :background "blue")))) (custom-documentation-face ((t (:foreground "light blue")))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:foreground "pale turquoise" :bold t)))) (custom-group-tag-face-1 ((t (:foreground "pale turquoise" :underline t)))) (custom-invalid-face ((t (:foreground "yellow" :background "red")))) (custom-modified-face ((t (:foreground "white" :background "blue")))) (custom-rogue-face ((t (:foreground "pink" :background "black")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:foreground "blue" :background "white")))) (custom-state-face ((t (:foreground "light salmon")))) (custom-variable-button-face ((t (:bold t :underline t)))) (custom-variable-tag-face ((t (:foreground "turquoise" :bold t)))) (diary-face ((t (:foreground "red")))) (dired-face-directory ((t (:bold t :foreground "sky blue")))) (dired-face-permissions ((t (:foreground "aquamarine")))) (dired-face-flagged ((t (:foreground "tomato")))) (dired-face-marked ((t (:foreground "light salmon")))) (dired-face-executable ((t (:foreground "green yellow")))) (eshell-ls-archive-face ((t (:bold t :foreground "medium purple")))) (eshell-ls-backup-face ((t (:foreground "dim gray")))) (eshell-ls-clutter-face ((t (:foreground "dim gray")))) (eshell-ls-directory-face ((t (:bold t :foreground "medium slate blue")))) (eshell-ls-executable-face ((t (:bold t :foreground "aquamarine")))) (eshell-ls-missing-face ((t (:foreground "black")))) (eshell-ls-picture-face ((t (:foreground "violet")))) (eshell-ls-product-face ((t (:foreground "light steel blue")))) (eshell-ls-readonly-face ((t (:foreground "aquamarine")))) (eshell-ls-special-face ((t (:foreground "gold")))) (eshell-ls-symlink-face ((t (:foreground "white")))) (eshell-ls-unreadable-face ((t (:foreground "dim gray")))) (eshell-prompt-face ((t (:foreground "light sky blue" :bold t)))) (excerpt ((t (:italic t)))) (fixed ((t (:bold t)))) (flyspell-duplicate-face ((t (:foreground "Gold3" :bold t :underline t)))) (flyspell-incorrect-face ((t (:foreground "OrangeRed" :bold t :underline t)))) (font-lock-builtin-face ((t (:foreground "aquamarine")))) (font-lock-comment-face ((t (:foreground "light blue")))) (font-lock-constant-face ((t (:foreground "pale green")))) (font-lock-doc-string-face ((t (:foreground "sky blue")))) (font-lock-function-name-face ((t (:bold t :foreground "aquamarine")))) (font-lock-keyword-face ((t (:foreground "pale turquoise" :bold t)))) (font-lock-reference-face ((t (:foreground "pale green")))) (font-lock-string-face ((t (:foreground "light sky blue")))) (font-lock-type-face ((t (:foreground "sky blue" :bold t)))) (font-lock-variable-name-face ((t (:foreground "turquoise" :bold t)))) (font-lock-warning-face ((t (:foreground "Red" :bold t)))) (fringe ((t (:background "MidnightBlue")))) (header-line ((t (:background "#002" :foreground "cornflower blue")))) (highlight ((t (:background "dark slate blue" :foreground "light blue")))) (highline-face ((t (:background "DeepSkyBlue4")))) (holiday-face ((t (:background "pink")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:bold t)))) (info-xref ((t (:bold t :foreground "sky blue")))) (isearch ((t (:background "slate blue")))) (italic ((t (:foreground "sky blue")))) (makefile-space-face ((t (:background "hotpink")))) (menu ((t (:background "MidnightBlue" :foreground "Grey")))) (modeline ((t (:foreground "wheat" :background "slate blue")))) (mode-line-inactive ((t (:background "dark slate blue" :foreground "wheat")))) (modeline-buffer-id ((t (:foreground "beige" :background "slate blue")))) (modeline-mousable ((t (:foreground "light cyan" :background "slate blue")))) (modeline-mousable-minor-mode ((t (:foreground "wheat" :background "slate blue")))) (region ((t (:background "DarkSlateBlue")))) (secondary-selection ((t (:background "steel blue")))) (show-paren-match-face ((t (:foreground "white" :background "light slate blue")))) (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) (speedbar-button-face ((t (:foreground "seashell2")))) (speedbar-directory-face ((t (:foreground "seashell3")))) (speedbar-file-face ((t (:foreground "seashell4")))) (speedbar-highlight-face ((t (:background "dark slate blue" :foreground "wheat")))) (speedbar-selected-face ((t (:foreground "seashell1" :underline t)))) (speedbar-tag-face ((t (:foreground "antique white")))) (tool-bar ((t (:background "MidnightBlue" :foreground "Grey" :box (:line-width 1 :style released-button))))) (underline ((t (:underline t)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "light blue")))) (widget-field-face ((t (:background "RoyalBlue4" :foreground "wheat")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "slate blue" :foreground "wheat")))) (woman-bold-face ((t (:foreground "sky blue" :bold t)))) (woman-italic-face ((t (:foreground "deep sky blue")))) (woman-unknown-face ((t (:foreground "LightSalmon")))) (zmacs-region ((t (:background "DarkSlateBlue")))))))) (defun color-theme-rotor () "Black on Beige color theme by Jinwei Shen, created 2000-06-08. Supports default faces, font-lock, custom, widget, message, man, show-paren, viper." (interactive) (color-theme-install '(color-theme-rotor ((background-color . "Beige") (background-mode . light) (border-color . "black") (cursor-color . "Maroon") (foreground-color . "Black") (mouse-color . "Black")) ((Man-overstrike-face . font-lock-function-name-face) (Man-underline-face . font-lock-type-face) (list-matching-lines-face . bold) (rmail-highlight-face . font-lock-function-name-face) (watson-attribution-face . italic) (watson-url-face . bold) (watson-url-mouse-face . highlight)) (default ((t (nil)))) (bold ((t (:bold t :background "grey40" :foreground "yellow")))) (bold-italic ((t (:italic t :bold t :foreground "yellow green")))) (custom-button-face ((t (nil)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "blue")))) (font-lock-builtin-face ((t (:foreground "Orchid")))) (font-lock-comment-face ((t (:foreground "MediumBlue")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-function-name-face ((t (:foreground "MediumSlateBlue")))) (font-lock-keyword-face ((t (:foreground "#80a0ff")))) (font-lock-string-face ((t (:foreground "red")))) (font-lock-type-face ((t (:foreground "ForestGreen")))) (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (highlight ((t (:background "PaleGreen" :foreground "black")))) (italic ((t (:italic t :foreground "yellow3")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:background "wheat" :foreground "DarkOliveGreen")))) (modeline-buffer-id ((t (:background "wheat" :foreground "DarkOliveGreen")))) (modeline-mousable ((t (:background "wheat" :foreground "DarkOliveGreen")))) (modeline-mousable-minor-mode ((t (:background "wheat" :foreground "DarkOliveGreen")))) (nil ((t (nil)))) (region ((t (:background "dark cyan" :foreground "cyan")))) (secondary-selection ((t (:background "Turquoise" :foreground "black")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (underline ((t (:underline t)))) (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-search-face ((t (:background "khaki" :foreground "Black")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85"))))))) (defun color-theme-pierson () "Black on White color theme by Dan L. Pierson, created 2000-06-08. Supports default faces, font-lock, show-paren." (interactive) (color-theme-install '(color-theme-pierson ((background-color . "AntiqueWhite") (background-mode . light) (border-color . "black") (cursor-color . "Orchid") (foreground-color . "black") (mouse-color . "Orchid")) ((list-matching-lines-face . bold)) (default ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (font-lock-builtin-face ((t (:foreground "Orchid")))) (font-lock-comment-face ((t (:foreground "ForestGreen")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-function-name-face ((t (:foreground "blue3")))) (font-lock-keyword-face ((t (:foreground "Blue")))) (font-lock-string-face ((t (:foreground "Firebrick")))) (font-lock-type-face ((t (:foreground "Purple")))) (font-lock-variable-name-face ((t (:foreground "blue3")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (highlight ((t (:background "darkseagreen2")))) (italic ((t (:italic t)))) (modeline ((t (:foreground "antiquewhite" :background "black")))) (modeline-mousable-minor-mode ((t (:foreground "antiquewhite" :background "black")))) (modeline-mousable ((t (:foreground "antiquewhite" :background "black")))) (modeline-buffer-id ((t (:foreground "antiquewhite" :background "black")))) (region ((t (:background "gray")))) (secondary-selection ((t (:background "paleturquoise")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (underline ((t (:underline t))))))) (defun color-theme-xemacs () "XEmacs standard colors. If you are missing standard faces in this theme, please notify the maintainer. Currently, this theme includes the standard faces and font-lock faces, including some faces used in Emacs only but which are needed to recreate the look of the XEmacs color theme." (interactive) (color-theme-install '(color-theme-xemacs ((background-color . "gray80") (background-mode . light) (background-toolbar-color . "#cf3ccf3ccf3c") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#79e77df779e7") (cursor-color . "Red3") (foreground-color . "black") (top-toolbar-shadow-color . "#fffffbeeffff")) (default ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (border-glyph ((t (nil)))) (custom-button-face ((t (:bold t)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "blue")))) (dired-face-boring ((t (:foreground "Gray65")))) (dired-face-directory ((t (:bold t)))) (dired-face-executable ((t (:foreground "SeaGreen")))) (dired-face-flagged ((t (:background "LightSlateGray")))) (dired-face-marked ((t (:background "PaleVioletRed")))) (dired-face-permissions ((t (:background "grey75" :foreground "black")))) (dired-face-setuid ((t (:foreground "Red")))) (dired-face-socket ((t (:foreground "magenta")))) (dired-face-symlink ((t (:foreground "cyan")))) (font-lock-builtin-face ((t (:foreground "red3")))) (font-lock-comment-face ((t (:foreground "blue4")))) (font-lock-constant-face ((t (:foreground "red3")))) (font-lock-doc-string-face ((t (:foreground "green4")))) (font-lock-function-name-face ((t (:foreground "brown4")))) (font-lock-keyword-face ((t (:foreground "red4")))) (font-lock-preprocessor-face ((t (:foreground "blue3")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (:foreground "green4")))) (font-lock-type-face ((t (:foreground "steelblue")))) (font-lock-variable-name-face ((t (:foreground "magenta4")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (:background "Gray80")))) (highlight ((t (:background "darkseagreen2")))) (info-node ((t (:italic t :bold t)))) (info-xref ((t (:bold t)))) (isearch ((t (:background "paleturquoise")))) (italic ((t (:italic t)))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68")))) (modeline ((t (:background "Gray80")))) (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) (paren-blink-off ((t (:foreground "gray80")))) (paren-match ((t (:background "darkseagreen2")))) (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) (pointer ((t (nil)))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (region ((t (:background "gray65")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "paleturquoise")))) (text-cursor ((t (:background "Red3" :foreground "gray80")))) (toolbar ((t (:background "Gray80")))) (underline ((t (:underline t)))) (vertical-divider ((t (:background "Gray80")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "gray65"))))))) (defun color-theme-jsc-light () "Color theme by John S Cooper, created 2000-06-08." (interactive) (color-theme-install '(color-theme-jsc-light ((background-color . "white") (background-mode . light) (border-color . "black") (cursor-color . "Red") (foreground-color . "black") (mouse-color . "black")) ((gnus-mouse-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (default ((t (nil)))) (bold ((t (:bold t :foreground "red3")))) (bold-italic ((t (:italic t :bold t :foreground "red")))) (custom-button-face ((t (nil)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "blue")))) (font-lock-builtin-face ((t (:foreground "Orchid")))) (font-lock-comment-face ((t (:italic t :bold t :foreground "Red3")))) (font-lock-constant-face ((t (:foreground "navy")))) (font-lock-function-name-face ((t (:bold t :foreground "Blue")))) (font-lock-keyword-face ((t (:bold t :foreground "Purple")))) (font-lock-string-face ((t (:foreground "Green4")))) (font-lock-type-face ((t (:foreground "Navy")))) (font-lock-variable-name-face ((t (:foreground "Tan4")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (gnus-cite-attribution-face ((t (:italic t)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "blue2")))) (gnus-group-news-1-face ((t (:bold t :foreground "blue2")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-header-content-face ((t (:italic t :foreground "blue")))) (gnus-header-from-face ((t (:foreground "red3")))) (gnus-header-name-face ((t (:foreground "red3")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) (gnus-header-subject-face ((t (:bold t :foreground "red")))) (gnus-signature-face ((t (:foreground "pink")))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "navy")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-high-unread-face ((t (:bold t :foreground "blue")))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "red3")))) (gnus-summary-normal-ticked-face ((t (:foreground "black")))) (gnus-summary-normal-unread-face ((t (:bold t :foreground "red3")))) (gnus-summary-selected-face ((t (:underline t)))) (highlight ((t (:background "antiquewhite" :foreground "blue")))) (italic ((t (:italic t)))) (makefile-space-face ((t (:background "hotpink")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:background "plum" :foreground "black")))) (modeline-buffer-id ((t (:background "plum" :foreground "black")))) (modeline-mousable ((t (:background "plum" :foreground "black")))) (modeline-mousable-minor-mode ((t (:background "plum" :foreground "black")))) (region ((t (:background "plum")))) (secondary-selection ((t (:background "palegreen")))) (show-paren-match-face ((t (:background "plum")))) (show-paren-mismatch-face ((t (:background "navy" :foreground "white")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:underline t :foreground "red")))) (speedbar-tag-face ((t (:foreground "brown")))) (underline ((t (:underline t)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85"))))))) (defun color-theme-jsc-dark () "Color theme by John S Cooper, created 2000-06-11." (interactive) (color-theme-install '(color-theme-jsc-dark ((background-color . "black") (background-mode . dark) (border-color . "black") (cursor-color . "white") (foreground-color . "cornsilk") (mouse-color . "black")) ((gnus-mouse-face . highlight) (goto-address-mail-face . italic) (goto-address-mail-mouse-face . secondary-selection) (goto-address-url-face . bold) (goto-address-url-mouse-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (blank-space-face ((t (:background "LightGray")))) (blank-tab-face ((t (:background "cornsilk" :foreground "black")))) (default ((t (nil)))) (bold ((t (:bold t :foreground "white")))) (bold-italic ((t (:italic t :bold t)))) (calendar-today-face ((t (:underline t)))) (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (custom-button-face ((t (:foreground "white")))) (custom-changed-face ((t (:background "skyblue" :foreground "wheat")))) (custom-documentation-face ((t (:foreground "white")))) (custom-face-tag-face ((t (:underline t :foreground "white")))) (custom-group-tag-face ((t (:underline t :foreground "skyblue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:foreground "blue")))) (custom-state-face ((t (:foreground "light green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "skyblue")))) (diary-face ((t (:bold t :foreground "orange")))) (font-lock-builtin-face ((t (:bold t :foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:italic t :foreground "red")))) (font-lock-constant-face ((t (:bold t :foreground "salmon")))) (font-lock-function-name-face ((t (:bold t :foreground "orange")))) (font-lock-keyword-face ((t (:bold t :foreground "gold")))) (font-lock-string-face ((t (:italic t :foreground "orange")))) (font-lock-type-face ((t (:bold t :foreground "gold")))) (font-lock-variable-name-face ((t (:italic t :bold t :foreground "light salmon")))) (font-lock-warning-face ((t (:bold t :foreground "gold")))) (gnus-cite-attribution-face ((t (:italic t)))) (gnus-cite-face-1 ((t (:foreground "light cyan")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "light blue")))) (gnus-cite-face-3 ((t (:foreground "light yellow")))) (gnus-cite-face-4 ((t (:foreground "light pink")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:foreground "beige")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:background "goldenrod4" :foreground "white")))) (gnus-emphasis-underline-bold ((t (:underline t :bold t :background "yellow" :foreground "black")))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t :background "yellow" :foreground "black")))) (gnus-emphasis-underline-italic ((t (:underline t :italic t :background "yellow" :foreground "black")))) (gnus-filterhist-face-1 ((t (nil)))) (gnus-group-mail-1-empty-face ((t (:foreground "gray80")))) (gnus-group-mail-1-face ((t (:bold t :foreground "white")))) (gnus-group-mail-2-empty-face ((t (:foreground "lightcyan")))) (gnus-group-mail-2-face ((t (:bold t :foreground "lightcyan")))) (gnus-group-mail-3-empty-face ((t (:foreground "tan")))) (gnus-group-mail-3-face ((t (:bold t :foreground "tan")))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) (gnus-group-news-1-empty-face ((t (:foreground "white")))) (gnus-group-news-1-face ((t (:bold t :foreground "white")))) (gnus-group-news-2-empty-face ((t (:foreground "lightcyan")))) (gnus-group-news-2-face ((t (:bold t :foreground "lightcyan")))) (gnus-group-news-3-empty-face ((t (:foreground "tan")))) (gnus-group-news-3-face ((t (:bold t :foreground "tan")))) (gnus-group-news-4-empty-face ((t (:foreground "white")))) (gnus-group-news-4-face ((t (:bold t :foreground "white")))) (gnus-group-news-5-empty-face ((t (:foreground "wheat")))) (gnus-group-news-5-face ((t (:bold t :foreground "wheat")))) (gnus-group-news-6-empty-face ((t (:foreground "tan")))) (gnus-group-news-6-face ((t (:bold t :foreground "tan")))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) (gnus-header-content-face ((t (:italic t :foreground "plum1")))) (gnus-header-from-face ((t (:bold t :foreground "wheat")))) (gnus-header-name-face ((t (:bold t :foreground "gold")))) (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "wheat")))) (gnus-header-subject-face ((t (:bold t :foreground "red")))) (gnus-signature-face ((t (:italic t :foreground "maroon")))) (gnus-splash ((t (:foreground "Brown")))) (gnus-splash-face ((t (:foreground "gold")))) (gnus-summary-cancelled-face ((t (:background "gray" :foreground "black")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "gray70")))) (gnus-summary-high-unread-face ((t (:italic t :bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "gray70")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:bold t :foreground "gray70")))) (gnus-summary-normal-unread-face ((t (:bold t)))) (gnus-summary-selected-face ((t (:underline t :background "deepskyblue4")))) (highlight ((t (:background "darkslategray" :foreground "wheat")))) (highlight-changes-delete-face ((t (:underline t :foreground "red")))) (highlight-changes-face ((t (:foreground "red")))) (highline-face ((t (:background "gray35")))) (holiday-face ((t (:background "red")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:italic t :bold t :foreground "yellow")))) (info-xref ((t (:bold t :foreground "plum")))) (italic ((t (:italic t)))) (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) (linemenu-face ((t (:background "gray30")))) (makefile-space-face ((t (:background "hotpink")))) (message-cited-text-face ((t (:foreground "plum1")))) (message-header-cc-face ((t (:bold t :foreground "ivory")))) (message-header-name-face ((t (:foreground "light sky blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "lavender blush")))) (message-header-other-face ((t (:foreground "pale turquoise")))) (message-header-subject-face ((t (:bold t :foreground "papaya whip")))) (message-header-to-face ((t (:bold t :foreground "floral white")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:bold t :foreground "ForestGreen")))) (message-separator-face ((t (:foreground "sandy brown")))) (modeline ((t (:background "tan" :foreground "black")))) (modeline-buffer-id ((t (:background "tan" :foreground "black")))) (modeline-mousable ((t (:background "tan" :foreground "black")))) (modeline-mousable-minor-mode ((t (:background "tan" :foreground "black")))) (paren-mismatch-face ((t (:bold t :background "white" :foreground "red")))) (paren-no-match-face ((t (:bold t :background "white" :foreground "red")))) (region ((t (:background "slategrey")))) (secondary-selection ((t (:background "deepskyblue4")))) (sgml-doctype-face ((t (:foreground "orange")))) (sgml-end-tag-face ((t (:foreground "greenyellow")))) (sgml-entity-face ((t (:foreground "gold")))) (sgml-ignored-face ((t (:background "gray60" :foreground "gray20")))) (sgml-sgml-face ((t (:foreground "yellow")))) (sgml-start-tag-face ((t (:foreground "mediumspringgreen")))) (show-paren-match-face ((t (:background "deepskyblue4")))) (show-paren-mismatch-face ((t (:bold t :background "red" :foreground "white")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:bold t :foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:underline t :foreground "red")))) (speedbar-tag-face ((t (:foreground "brown")))) (underline ((t (:underline t)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "gray20")))) (widget-inactive-face ((t (:foreground "wheat")))) (widget-single-line-field-face ((t (:background "gray20")))) (woman-bold-face ((t (:bold t)))) (woman-italic-face ((t (:foreground "beige")))) (woman-unknown-face ((t (:foreground "LightSalmon"))))))) (defun color-theme-greiner () "Color theme by Kevin Greiner, created 2000-06-13. Black on Beige, supports default, font-lock, speedbar, custom, widget faces. Designed to be easy on the eyes, particularly on Win32 computers which commonly have white window backgrounds." (interactive) (color-theme-install '(color-theme-greiner ((background-color . "beige") (background-mode . light) (border-color . "black") (cursor-color . "black") (foreground-color . "black") (mouse-color . "black")) ((list-matching-lines-face . bold)) (default ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (custom-button-face ((t (nil)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "blue")))) (font-lock-builtin-face ((t (:foreground "blue4")))) (font-lock-comment-face ((t (:foreground "Firebrick")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-function-name-face ((t (:foreground "Blue")))) (font-lock-keyword-face ((t (:foreground "royal blue")))) (font-lock-string-face ((t (:foreground "RosyBrown")))) (font-lock-type-face ((t (:foreground "ForestGreen")))) (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (highlight ((t (:background "darkseagreen2")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:italic t :bold t)))) (info-xref ((t (:bold t)))) (italic ((t (:italic t)))) (modeline ((t (:background "black" :foreground "white")))) (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) (modeline-mousable ((t (:background "black" :foreground "white")))) (modeline-buffer-id ((t (:background "black" :foreground "white")))) (region ((t (:background "gray")))) (secondary-selection ((t (:background "paleturquoise")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:underline t :foreground "red")))) (speedbar-tag-face ((t (:foreground "brown")))) (underline ((t (:underline t)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85"))))))) (defun color-theme-jb-simple () "Color theme by jeff, created 2000-06-14. Uses white background and bold for many things" (interactive) (color-theme-install '(color-theme-jb-simple ((background-color . "white") (background-mode . light) (background-toolbar-color . "#cf3ccf3ccf3c") (border-color . "black") (bottom-toolbar-shadow-color . "#79e77df779e7") (cursor-color . "black") (foreground-color . "black") (mouse-color . "black") (top-toolbar-shadow-color . "#fffffbeeffff")) ((gnus-mouse-face . highlight) (list-matching-lines-face . bold) (rmail-highlight-face . font-lock-function-name-face) (view-highlight-face . highlight)) (default ((t (nil)))) (blank-space-face ((t (nil)))) (blank-tab-face ((t (nil)))) (blue ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (border-glyph ((t (nil)))) (calendar-today-face ((t (:underline t)))) (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (custom-button-face ((t (:bold t)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :bold t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :bold t :foreground "blue")))) (diary-face ((t (:bold t :foreground "red")))) (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) (erc-action-face ((t (:bold t)))) (erc-bold-face ((t (:bold t)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (nil)))) (erc-error-face ((t (:bold t)))) (erc-input-face ((t (nil)))) (erc-inverse-face ((t (nil)))) (erc-notice-face ((t (nil)))) (erc-pal-face ((t (nil)))) (erc-prompt-face ((t (nil)))) (erc-underline-face ((t (nil)))) (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) (eshell-ls-picture-face ((t (nil)))) (eshell-ls-product-face ((t (:foreground "OrangeRed")))) (eshell-ls-readonly-face ((t (:foreground "Brown")))) (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) (eshell-prompt-face ((t (:bold t :foreground "Red")))) (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) (eshell-test-ok-face ((t (:bold t :foreground "Green")))) (excerpt ((t (:italic t)))) (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) (fixed ((t (:bold t)))) (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) (font-latex-bold-face ((t (nil)))) (font-latex-italic-face ((t (nil)))) (font-latex-math-face ((t (nil)))) (font-latex-sedate-face ((t (nil)))) (font-latex-string-face ((t (nil)))) (font-latex-warning-face ((t (nil)))) (font-lock-builtin-face ((t (:bold t :foreground "Orchid")))) (font-lock-comment-face ((t (:italic t :bold t :foreground "blue4")))) (font-lock-constant-face ((t (:bold t :foreground "CadetBlue")))) (font-lock-doc-string-face ((t (:italic t :bold t :foreground "blue4")))) (font-lock-exit-face ((t (nil)))) (font-lock-function-name-face ((t (:bold t :foreground "brown4")))) (font-lock-keyword-face ((t (:bold t :foreground "black")))) (font-lock-preprocessor-face ((t (:foreground "blue3")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (:italic t :bold t :foreground "green4")))) (font-lock-type-face ((t (:bold t :foreground "steelblue")))) (font-lock-variable-name-face ((t (:italic t :bold t :foreground "magenta4")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (gnus-cite-attribution-face ((t (:italic t :bold t)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (nil)))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) (gnus-filterhist-face-1 ((t (nil)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) (gnus-header-from-face ((t (:bold t :foreground "red3")))) (gnus-header-name-face ((t (:bold t :foreground "maroon")))) (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MidnightBlue")))) (gnus-header-subject-face ((t (:bold t :foreground "red4")))) (gnus-signature-face ((t (:italic t)))) (gnus-splash ((t (nil)))) (gnus-splash-face ((t (:foreground "ForestGreen")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-high-unread-face ((t (:italic t :bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "firebrick")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (:bold t)))) (gnus-summary-selected-face ((t (:underline t)))) (green ((t (nil)))) (gui-button-face ((t (:background "grey75")))) (gui-element ((t (:background "Gray80")))) (highlight ((t (:background "darkseagreen2")))) (highlight-changes-delete-face ((t (:underline t :foreground "red")))) (highlight-changes-face ((t (:foreground "red")))) (highline-face ((t (:background "paleturquoise")))) (holiday-face ((t (:background "pink")))) (html-helper-italic-face ((t (:italic t)))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:italic t :bold t)))) (info-xref ((t (:bold t)))) (isearch ((t (nil)))) (italic ((t (:italic t)))) (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) (left-margin ((t (nil)))) (linemenu-face ((t (nil)))) (list-mode-item-selected ((t (nil)))) (makefile-space-face ((t (:background "hotpink")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:bold t)))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:background "darkblue" :foreground "yellow")))) (modeline-buffer-id ((t (:background "black" :foreground "white")))) (modeline-mousable ((t (:background "black" :foreground "white")))) (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) (nil ((t (nil)))) (paren-mismatch-face ((t (:bold t)))) (paren-no-match-face ((t (:bold t)))) (pointer ((t (nil)))) (primary-selection ((t (nil)))) (red ((t (nil)))) (region ((t (:background "gray")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "paleturquoise")))) (sgml-doctype-face ((t (nil)))) (sgml-end-tag-face ((t (nil)))) (sgml-entity-face ((t (nil)))) (sgml-ignored-face ((t (nil)))) (sgml-sgml-face ((t (nil)))) (sgml-start-tag-face ((t (nil)))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:bold t :background "purple" :foreground "white")))) (speedbar-button-face ((t (:bold t :foreground "green4")))) (speedbar-directory-face ((t (:bold t :foreground "blue4")))) (speedbar-file-face ((t (:bold t :foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:underline t :foreground "red")))) (speedbar-tag-face ((t (:foreground "brown")))) (swbuff-current-buffer-face ((t (:bold t)))) (term-black ((t (:foreground "black")))) (term-blackbg ((t (:background "black")))) (term-blue ((t (:foreground "blue")))) (term-bluebg ((t (:background "blue")))) (term-bold ((t (:bold t)))) (term-cyan ((t (:foreground "cyan")))) (term-cyanbg ((t (:background "cyan")))) (term-default-bg ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-default-fg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-green ((t (:foreground "green")))) (term-greenbg ((t (:background "green")))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-magenta ((t (:foreground "magenta")))) (term-magentabg ((t (:background "magenta")))) (term-red ((t (:foreground "red")))) (term-redbg ((t (:background "red")))) (term-underline ((t (:underline t)))) (term-white ((t (:foreground "white")))) (term-whitebg ((t (:background "white")))) (term-yellow ((t (:foreground "yellow")))) (term-yellowbg ((t (:background "yellow")))) (text-cursor ((t (nil)))) (toolbar ((t (nil)))) (underline ((t (:underline t)))) (vc-annotate-face-0046FF ((t (nil)))) (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) (vertical-divider ((t (nil)))) (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-search-face ((t (:background "khaki" :foreground "Black")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85")))) (woman-bold-face ((t (:bold t)))) (woman-italic-face ((t (nil)))) (woman-unknown-face ((t (nil)))) (yellow ((t (nil)))) (zmacs-region ((t (nil))))))) (defun color-theme-beige-diff () "Brownish faces for diff and change-log modes. This is intended for other color themes to use (eg. `color-theme-gnome2' and `color-theme-blue-sea')." (color-theme-install '(color-theme-beige-diff nil (change-log-acknowledgement-face ((t (:foreground "firebrick")))) (change-log-conditionals-face ((t (:foreground "khaki" :background "sienna")))) (change-log-date-face ((t (:foreground "gold")))) (change-log-email-face ((t (:foreground "khaki" :underline t)))) (change-log-file-face ((t (:bold t :foreground "lemon chiffon")))) (change-log-function-face ((t (:foreground "khaki" :background "sienna")))) (change-log-list-face ((t (:foreground "wheat")))) (change-log-name-face ((t (:bold t :foreground "light goldenrod")))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-context-face ((t (:foreground "grey50")))) (diff-file-header-face ((t (:bold t :foreground "lemon chiffon")))) (diff-function-face ((t (:foreground "grey50")))) (diff-header-face ((t (:foreground "lemon chiffon")))) (diff-hunk-header-face ((t (:foreground "light goldenrod")))) (diff-index-face ((t (:bold t :underline t)))) (diff-nonexistent-face ((t (:bold t :background "grey70" :weight bold)))) (diff-removed-face ((t (nil)))) (log-view-message-face ((t (:foreground "lemon chiffon"))))))) (defun color-theme-standard-ediff () "Standard colors for ediff faces. This is intended for other color themes to use \(eg. `color-theme-goldenrod')." (color-theme-install '(color-theme-beige-diff nil (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White"))))))) (defun color-theme-beige-eshell () "Brownish colors for eshell faces only. This is intended for other color themes to use (eg. `color-theme-goldenrod')." (color-theme-install '(color-theme-beige-eshell nil (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) (eshell-ls-backup-face ((t (:foreground "Grey")))) (eshell-ls-clutter-face ((t (:foreground "DimGray")))) (eshell-ls-directory-face ((t (:bold t :foreground "dark khaki")))) (eshell-ls-executable-face ((t (:foreground "Coral")))) (eshell-ls-missing-face ((t (:foreground "black")))) (eshell-ls-picture-face ((t (:foreground "gold")))) ; non-standard face (eshell-ls-product-face ((t (:foreground "dark sea green")))) (eshell-ls-readonly-face ((t (:foreground "light steel blue")))) (eshell-ls-special-face ((t (:foreground "gold")))) (eshell-ls-symlink-face ((t (:foreground "peach puff")))) (eshell-ls-text-face ((t (:foreground "moccasin")))) ; non-standard face (eshell-ls-todo-face ((t (:bold t :foreground "yellow green")))) ; non-standard face (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) (eshell-prompt-face ((t (:foreground "lemon chiffon"))))))) (defun color-theme-goldenrod () "Brown color theme. Very different from the others. Supports standard, font-lock and info faces, and it uses `color-theme-blue-gnus', `color-theme-blue-erc' , and `color-theme-beige-diff'." (interactive) (color-theme-blue-gnus) (let ((color-theme-is-cumulative t)) (color-theme-blue-erc) (color-theme-beige-diff) (color-theme-beige-eshell) (color-theme-install '(color-theme-goldenrod ((background-color . "black") (background-mode . dark) (border-color . "black") (cursor-color . "light goldenrod") (foreground-color . "goldenrod") (mouse-color . "goldenrod")) ((goto-address-mail-face . info-xref) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (default ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t :foreground "lavender")))) (font-lock-builtin-face ((t (:foreground "pale goldenrod")))) (font-lock-comment-face ((t (:foreground "indian red")))) (font-lock-constant-face ((t (:foreground "pale green")))) (font-lock-function-name-face ((t (:bold t :foreground "lemon chiffon")))) (font-lock-keyword-face ((t (:foreground "wheat")))) (font-lock-string-face ((t (:foreground "gold")))) (font-lock-type-face ((t (:foreground "dark khaki" :bold t)))) (font-lock-variable-name-face ((t (:bold t :foreground "khaki")))) (font-lock-warning-face ((t (:bold t :foreground "orange red")))) (fringe ((t (:background "gray25")))) (header-line ((t (:background "gray20" :foreground "gray70")))) (highlight ((t (:background "dark slate blue")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:bold t)))) (info-xref ((t (:bold t :foreground "pale goldenrod")))) (isearch ((t (:background "SeaGreen4")))) (isearch-lazy-highlight-face ((t (:background "DarkOliveGreen4")))) (italic ((t (:italic t :foreground "lavender")))) (menu ((t (:background "gray25" :foreground "lemon chiffon")))) (modeline ((t (:background "gray40" :foreground "lemon chiffon" :box (:line-width 1 :style released-button))))) (modeline-buffer-id ((t (:background "AntiqueWhite4" :foreground "lemon chiffon")))) (modeline-mousable ((t (:background "AntiqueWhite4" :foreground "lemon chiffon")))) (modeline-mousable-minor-mode ((t (:background "wheat" :foreground "lemon chiffon")))) (mode-line-inactive ((t (:background "gray20" :foreground "lemon chiffon" :box (:line-width 1 :style released-button))))) (region ((t (:background "dark olive green")))) (secondary-selection ((t (:background "dark green")))) (tool-bar ((t (:background "gray25" :foreground "lemon chiffon" :box (:line-width 1 :style released-button))))) (underline ((t (:underline t)))))))) (defun color-theme-ramangalahy () "Color theme by Solofo Ramangalahy, created 2000-10-18. Black on light grey, includes faces for vm, ispell, gnus, dired, display-time, cperl, font-lock, widget, x-symbol." (interactive) (color-theme-install '(color-theme-ramangalahy ((background-color . "lightgrey") (background-mode . light) (background-toolbar-color . "#bfbfbfbfbfbf") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#737373737373") (cursor-color . "blue") (foreground-color . "black") (top-toolbar-shadow-color . "#e6e6e6e6e6e6")) ((gnus-mouse-face . highlight) (goto-address-mail-face . info-xref) (ispell-highlight-face . highlight) (notes-bold-face . notes-bold-face) (setnu-line-number-face . bold) (tinyreplace-:face . highlight) (vm-highlight-url-face . bold-italic) (vm-highlighted-header-face . bold) (vm-mime-button-face . gui-button-face) (vm-summary-highlight-face . bold)) (default ((t (nil)))) (bbdb-company ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (border-glyph ((t (nil)))) (cperl-here-face ((t (:foreground "green4")))) (cperl-pod-face ((t (:foreground "brown4")))) (cperl-pod-head-face ((t (:foreground "steelblue")))) (custom-button-face ((t (:bold t)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "blue")))) (dired-face-boring ((t (:foreground "Gray65")))) (dired-face-directory ((t (:bold t)))) (dired-face-executable ((t (:foreground "SeaGreen")))) (dired-face-flagged ((t (:background "LightSlateGray")))) (dired-face-marked ((t (:background "PaleVioletRed")))) (dired-face-permissions ((t (:background "grey75" :foreground "black")))) (dired-face-setuid ((t (:foreground "Red")))) (dired-face-socket ((t (:foreground "magenta")))) (dired-face-symlink ((t (:foreground "blue")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "red")))) (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) (font-lock-comment-face ((t (:bold t :foreground "purple")))) (font-lock-doc-string-face ((t (:bold t :foreground "slateblue")))) (font-lock-emphasized-face ((t (:bold t :background "lightyellow2")))) (font-lock-function-name-face ((t (:bold t :foreground "blue")))) (font-lock-keyword-face ((t (:bold t :foreground "violetred")))) (font-lock-other-emphasized-face ((t (:italic t :bold t :background "lightyellow2")))) (font-lock-other-type-face ((t (:bold t :foreground "orange3")))) (font-lock-preprocessor-face ((t (:bold t :foreground "mediumblue")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (:foreground "green4")))) (font-lock-type-face ((t (:bold t :foreground "steelblue")))) (font-lock-variable-name-face ((t (:foreground "magenta4")))) (font-lock-warning-face ((t (:bold t :background "yellow" :foreground "Red")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (nil)))) (gnus-emphasis-italic ((t (nil)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t)))) (gnus-emphasis-underline-italic ((t (:underline t)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-news-3-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-header-content-face ((t (:foreground "indianred4")))) (gnus-header-from-face ((t (:foreground "red3")))) (gnus-header-name-face ((t (:foreground "maroon")))) (gnus-header-newsgroups-face ((t (:foreground "MidnightBlue")))) (gnus-header-subject-face ((t (:foreground "red4")))) (gnus-signature-face ((t (:bold t)))) (gnus-splash-face ((t (:foreground "ForestGreen")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-low-unread-face ((t (nil)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (gnus-x-face ((t (:background "lightgrey" :foreground "black")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (:background "lightgrey")))) (highlight ((t (:background "darkseagreen2")))) (info-node ((t (:underline t :bold t :foreground "mediumpurple")))) (info-xref ((t (:underline t :bold t :foreground "#0000ee")))) (isearch ((t (:background "paleturquoise")))) (italic ((t (:italic t)))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68" :foreground "black")))) (message-cited-text ((t (:foreground "slategrey")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-contents ((t (:italic t)))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-headers ((t (:bold t)))) (message-highlighted-header-contents ((t (:bold t)))) (message-separator-face ((t (:foreground "brown")))) (message-url ((t (:bold t)))) (modeline ((t (:bold t :background "Gray75" :foreground "Black")))) (modeline-buffer-id ((t (:bold t :background "Gray75" :foreground "blue4")))) (modeline-mousable ((t (:bold t :background "Gray75" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:bold t :background "Gray75" :foreground "green4")))) (paren-blink-off ((t (:foreground "lightgrey")))) (paren-match ((t (:background "darkseagreen2")))) (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) (pointer ((t (:foreground "blue")))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (region ((t (:background "black" :foreground "white")))) (right-margin ((t (nil)))) (searchm-buffer ((t (:bold t :background "white" :foreground "red")))) (searchm-button ((t (:bold t :background "CadetBlue" :foreground "white")))) (searchm-field ((t (:background "grey89")))) (searchm-field-label ((t (:bold t)))) (searchm-highlight ((t (:bold t :background "darkseagreen2" :foreground "black")))) (secondary-selection ((t (:background "paleturquoise")))) (template-message-face ((t (:bold t)))) (text-cursor ((t (:background "blue" :foreground "lightgrey")))) (toolbar ((t (nil)))) (underline ((t (:underline t)))) (vertical-divider ((t (nil)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (x-face ((t (:background "white" :foreground "black")))) (x-symbol-adobe-fontspecific-face ((t (nil)))) (x-symbol-face ((t (nil)))) (x-symbol-heading-face ((t (:underline t :bold t :foreground "green4")))) (x-symbol-info-face ((t (:foreground "green4")))) (x-symbol-invisible-face ((t (nil)))) (x-symbol-revealed-face ((t (:background "pink")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "yellow"))))))) (defun color-theme-raspopovic () "Color theme by Pedja Raspopovic, created 2000-10-19. Includes faces for dired, font-lock, info, paren." (interactive) (color-theme-install '(color-theme-raspopovic ((background-color . "darkblue") (background-mode . light) (background-toolbar-color . "#bfbfbfbfbfbf") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#737373737373") (cursor-color . "Red3") (foreground-color . "yellow") (top-toolbar-shadow-color . "#e6e6e6e6e6e6")) ((setnu-line-number-face . bold) (goto-address-mail-face . info-xref)) (default ((t (nil)))) (blue ((t (:background "darkblue" :foreground "blue")))) (bold ((t (:bold t :background "darkblue" :foreground "yellow")))) (bold-italic ((t (:bold t :background "darkblue" :foreground "red3")))) (comint-input-face ((t (:foreground "deepskyblue")))) (dired-face-boring ((t (:foreground "Gray65")))) (dired-face-directory ((t (:foreground "lightgreen")))) (dired-face-executable ((t (:foreground "indianred")))) (dired-face-flagged ((t (:background "LightSlateGray")))) (dired-face-marked ((t (:background "darkblue" :foreground "deepskyblue")))) (dired-face-permissions ((t (:background "darkblue" :foreground "white")))) (dired-face-setuid ((t (:foreground "Red")))) (dired-face-socket ((t (:foreground "magenta")))) (dired-face-symlink ((t (:foreground "grey95")))) (font-lock-comment-face ((t (:background "darkblue" :foreground "lightgreen")))) (font-lock-doc-string-face ((t (:background "darkblue" :foreground "darkseagreen")))) (font-lock-function-name-face ((t (:bold t :background "darkblue" :foreground "indianred")))) (font-lock-keyword-face ((t (:background "darkblue" :foreground "skyblue")))) (font-lock-preprocessor-face ((t (:background "darkblue" :foreground "orange")))) (font-lock-reference-face ((t (:background "darkblue" :foreground "deepskyblue")))) (font-lock-string-face ((t (:background "darkblue" :foreground "lightgrey")))) (font-lock-type-face ((t (:background "darkblue" :foreground "orange")))) (font-lock-variable-name-face ((t (:background "darkblue" :foreground "white")))) (green ((t (:background "darkblue" :foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (highlight ((t (:background "yellow" :foreground "darkblue")))) (info-node ((t (:bold t :background "darkblue" :foreground "red3")))) (info-xref ((t (:bold t :background "darkblue" :foreground "yellow")))) (isearch ((t (:background "yellow" :foreground "darkblue")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (:background "darkblue" :foreground "red3")))) (left-margin ((t (:background "darkblue" :foreground "yellow")))) (list-mode-item-selected ((t (:background "gray68" :foreground "yellow")))) (makefile-space-face ((t (:background "hotpink")))) (modeline ((t (:background "Gray75" :foreground "Black")))) (modeline-buffer-id ((t (:background "Gray75" :foreground "blue")))) (modeline-mousable ((t (:background "Gray75" :foreground "red")))) (modeline-mousable-minor-mode ((t (:background "Gray75" :foreground "green4")))) (paren-blink-off ((t (:foreground "darkblue")))) (paren-match ((t (:background "yellow" :foreground "darkblue")))) (paren-mismatch ((t (:background "DeepPink" :foreground "yellow")))) (pointer ((t (:background "darkblue" :foreground "red3")))) (primary-selection ((t (:background "yellow" :foreground "darkblue")))) (red ((t (:background "darkblue" :foreground "red")))) (right-margin ((t (:background "darkblue" :foreground "yellow")))) (secondary-selection ((t (:background "darkblue" :foreground "yellow")))) (shell-option-face ((t (:background "darkblue" :foreground "cyan2")))) (shell-output-2-face ((t (:background "darkblue" :foreground "darkseagreen")))) (shell-output-3-face ((t (:background "darkblue" :foreground "lightgrey")))) (shell-output-face ((t (:background "darkblue" :foreground "white")))) (shell-prompt-face ((t (:background "darkblue" :foreground "red")))) (text-cursor ((t (:background "Red3" :foreground "white")))) (underline ((t (:underline t :background "darkblue" :foreground "yellow")))) (vvb-face ((t (:background "pink" :foreground "black")))) (yellow ((t (:background "darkblue" :foreground "yellow")))) (zmacs-region ((t (:background "gray" :foreground "black"))))))) (defun color-theme-taylor () "Color theme by Art Taylor, created 2000-10-20. Wheat on black. Includes faces for font-lock, gnus, paren." (interactive) (color-theme-install '(color-theme-taylor ((background-color . "black") (background-mode . dark) (border-color . "black") (cursor-color . "red") (foreground-color . "wheat") (mouse-color . "black")) ((gnus-mouse-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (default ((t (nil)))) (bold ((t (:bold t :background "grey40" :foreground "yellow")))) (bold-italic ((t (:italic t :bold t :foreground "yellow green")))) (fl-comment-face ((t (:foreground "medium purple")))) (fl-function-name-face ((t (:foreground "green")))) (fl-keyword-face ((t (:foreground "LightGreen")))) (fl-string-face ((t (:foreground "light coral")))) (fl-type-face ((t (:foreground "cyan")))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:foreground "OrangeRed")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) (font-lock-keyword-face ((t (:foreground "Cyan")))) (font-lock-string-face ((t (:foreground "LightSalmon")))) (font-lock-type-face ((t (:foreground "PaleGreen")))) (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (highlight ((t (:background "black" :foreground "black")))) (italic ((t (:italic t :foreground "yellow3")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "green4")))) (message-header-name-face ((t (:foreground "DarkGreen")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) (message-header-other-face ((t (:foreground "#b00000")))) (message-header-subject-face ((t (:foreground "green3")))) (message-header-to-face ((t (:bold t :foreground "green2")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "blue3")))) (modeline ((t (:background "wheat" :foreground "black")))) (modeline-buffer-id ((t (:background "wheat" :foreground "black")))) (modeline-mousable ((t (:background "wheat" :foreground "black")))) (modeline-mousable-minor-mode ((t (:background "wheat" :foreground "black")))) (region ((t (:background "blue")))) (secondary-selection ((t (:background "darkslateblue" :foreground "black")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (underline ((t (:underline t)))) (xref-keyword-face ((t (:foreground "blue")))) (xref-list-default-face ((t (nil)))) (xref-list-pilot-face ((t (:foreground "navy")))) (xref-list-symbol-face ((t (:foreground "navy"))))))) (defun color-theme-marquardt () "Color theme by Colin Marquardt, created 2000-10-25. Black on bisque, a light color. Based on some settings from Robin S. Socha. Features some color changes to programming languages, especially vhdl-mode. You might also want to put something like Emacs*Foreground: Black Emacs*Background: bisque2 in your ~/.Xdefaults." (interactive) (color-theme-install '(color-theme-marquardt ((background-color . "bisque") (background-mode . light) (background-toolbar-color . "bisque") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#909099999999") (cursor-color . "Red3") (foreground-color . "black") (top-toolbar-shadow-color . "#ffffffffffff")) (default ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:bold t)))) (border-glyph ((t (nil)))) (calendar-today-face ((t (:underline t)))) (diary-face ((t (:foreground "red")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "red")))) (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) (font-lock-comment-face ((t (:foreground "gray50")))) (font-lock-doc-string-face ((t (:foreground "green4")))) (font-lock-function-name-face ((t (:foreground "darkorange")))) (font-lock-keyword-face ((t (:foreground "blue3")))) (font-lock-preprocessor-face ((t (:foreground "blue3")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-special-comment-face ((t (:foreground "blue4")))) (font-lock-special-keyword-face ((t (:foreground "red4")))) (font-lock-string-face ((t (:foreground "green4")))) (font-lock-type-face ((t (:foreground "steelblue")))) (font-lock-variable-name-face ((t (:foreground "black")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (:background "azure1" :foreground "Black")))) (highlight ((t (:background "darkseagreen2" :foreground "blue")))) (holiday-face ((t (:background "pink" :foreground "black")))) (info-node ((t (:bold t)))) (info-xref ((t (:bold t)))) (isearch ((t (:background "yellow" :foreground "red")))) (italic ((t (:bold t)))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68" :foreground "black")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:background "bisque2" :foreground "steelblue4")))) (modeline-buffer-id ((t (:background "bisque2" :foreground "blue4")))) (modeline-mousable ((t (:background "bisque2" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:background "bisque2" :foreground "green4")))) (paren-blink-off ((t (:foreground "azure1")))) (paren-face ((t (:background "lightgoldenrod")))) (paren-match ((t (:background "bisque2")))) (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) (paren-mismatch-face ((t (:background "DeepPink")))) (paren-no-match-face ((t (:background "yellow")))) (pointer ((t (:background "white" :foreground "blue")))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "paleturquoise")))) (shell-option-face ((t (:foreground "gray50")))) (shell-output-2-face ((t (:foreground "green4")))) (shell-output-3-face ((t (:foreground "green4")))) (shell-output-face ((t (:bold t)))) (shell-prompt-face ((t (:foreground "blue3")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:underline t :foreground "red")))) (speedbar-tag-face ((t (:foreground "brown")))) (text-cursor ((t (:background "Red3" :foreground "bisque")))) (toolbar ((t (:background "Gray80")))) (underline ((t (:underline t)))) (vertical-divider ((t (nil)))) (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "SaddleBrown")))) (vhdl-font-lock-function-face ((t (:foreground "DarkCyan")))) (vhdl-font-lock-generic-/constant-face ((t (:foreground "Gold3")))) (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-font-lock-type-face ((t (:foreground "ForestGreen")))) (vhdl-font-lock-variable-face ((t (:foreground "Grey50")))) (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) (vhdl-speedbar-subprogram-face ((t (:foreground "Orchid4")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "steelblue" :foreground "yellow"))))))) (defun color-theme-parus () "Color theme by Jon K Hellan, created 2000-11-01. White on dark blue color theme. There is some redundancy in the X resources, but I do not have time to find out which should go or which should stay: Emacs*dialog*Background: midnightblue Emacs*dialog*Foreground: white Emacs*popup*Background: midnightblue Emacs*popup*Foreground: white emacs*background: #00005a emacs*cursorColor: gray90 emacs*foreground: White emacs.dialog*.background: midnightblue emacs.menu*.background: midnightblue emacs.pane.menubar.background: midnightblue" (interactive) (color-theme-install '(color-theme-parus ((background-color . "#00005a") (background-mode . dark) (border-color . "black") (cursor-color . "yellow") (foreground-color . "White") (mouse-color . "yellow")) ((gnus-mouse-face . highlight) (list-matching-lines-face . bold) (paren-face . bold) (paren-mismatch-face . paren-mismatch-face) (paren-no-match-face . paren-no-match-face) (view-highlight-face . highlight)) (default ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (font-latex-bold-face ((t (:bold t :foreground "OliveDrab")))) (font-latex-italic-face ((t (:italic t :foreground "OliveDrab")))) (font-latex-math-face ((t (:foreground "burlywood")))) (font-latex-sedate-face ((t (:foreground "LightGray")))) (font-latex-string-face ((t (:foreground "LightSalmon")))) (font-latex-warning-face ((t (:foreground "Pink")))) (font-lock-builtin-face ((t (:foreground "#e0e0ff")))) (font-lock-reference-face ((t (:foreground "#e0e0ff")))) (font-lock-comment-face ((t (:foreground "#FFd1d1")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) (font-lock-function-name-face ((t (:foreground "#b2e4ff")))) (font-lock-keyword-face ((t (:foreground "#a0ffff")))) (font-lock-string-face ((t (:foreground "#efca10")))) (font-lock-doc-string-face ((t (:foreground "#efca10")))) (font-lock-type-face ((t (:foreground "PaleGreen")))) (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (gnus-cite-attribution-face ((t (:italic t)))) (gnus-cite-face-1 ((t (:foreground "#dfdfff")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "light cyan")))) (gnus-cite-face-3 ((t (:foreground "light yellow")))) (gnus-cite-face-4 ((t (:foreground "light pink")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:foreground "beige")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) (gnus-header-content-face ((t (:italic t :foreground "#90f490")))) (gnus-header-from-face ((t (:foreground "#aaffaa")))) (gnus-header-name-face ((t (:foreground "#c7e3c7")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow")))) (gnus-header-subject-face ((t (:foreground "#a0f0a0")))) (gnus-signature-face ((t (:italic t)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (highlight ((t (:background "darkolivegreen")))) (italic ((t (:italic t)))) (message-cited-text-face ((t (:foreground "#dfdfff")))) (message-header-cc-face ((t (:bold t :foreground "#a0f0a0")))) (message-header-name-face ((t (:foreground "#c7e3c7")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) (message-header-other-face ((t (:foreground "#db9b9b")))) (message-header-subject-face ((t (:foreground "#a0f0a0")))) (message-header-to-face ((t (:bold t :foreground "#aaffaa")))) (message-header-xheader-face ((t (:foreground "#e2e2ff")))) (message-mml-face ((t (:foreground "#abdbab")))) (message-separator-face ((t (:foreground "#dfdfff")))) (modeline ((t (:background "White" :foreground "#00005a")))) (modeline-buffer-id ((t (:background "White" :foreground "#00005a")))) (modeline-mousable ((t (:background "White" :foreground "#00005a")))) (modeline-mousable-minor-mode ((t (:background "White" :foreground "#00005a")))) (paren-mismatch-face ((t (:background "DeepPink")))) (paren-no-match-face ((t (:background "yellow")))) (region ((t (:background "blue")))) (primary-selection ((t (:background "blue")))) (isearch ((t (:background "blue")))) (secondary-selection ((t (:background "darkslateblue")))) (underline ((t (:underline t)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray"))))))) (defun color-theme-high-contrast () "High contrast color theme, maybe for the visually impaired. Watch out! This will set a very large font-size! If you want to modify the font as well, you should customize variable `color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". The default setting will prevent color themes from installing specific fonts." (interactive) (color-theme-standard) (let ((color-theme-is-cumulative t)) (color-theme-install '(color-theme-high-contrast ((cursor-color . "red") (width . 60) (height . 25) (background . dark)) (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :height 240 :width normal :family "adobe-courier")))) (bold ((t (:bold t :underline t)))) (bold-italic ((t (:bold t :underline t)))) (font-lock-builtin-face ((t (:bold t :foreground "Red")))) (font-lock-comment-face ((t (:bold t :foreground "Firebrick")))) (font-lock-constant-face ((t (:bold t :underline t :foreground "Blue")))) (font-lock-function-name-face ((t (:bold t :foreground "Blue")))) (font-lock-keyword-face ((t (:bold t :foreground "Purple")))) (font-lock-string-face ((t (:bold t :foreground "DarkGreen")))) (font-lock-type-face ((t (:bold t :foreground "ForestGreen")))) (font-lock-variable-name-face ((t (:bold t :foreground "DarkGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (highlight ((t (:background "black" :foreground "white" :bold 1)))) (info-menu-5 ((t (:underline t :bold t)))) (info-node ((t (:bold t)))) (info-xref ((t (:bold t )))) (italic ((t (:bold t :underline t)))) (modeline ((t (:background "black" :foreground "white" :bold 1)))) (modeline-buffer-id ((t (:background "black" :foreground "white" :bold 1)))) (modeline-mousable ((t (:background "black" :foreground "white" :bold 1)))) (modeline-mousable-minor-mode ((t (:background "black" :foreground "white" :bold 1)))) (region ((t (:background "black" :foreground "white" :bold 1)))) (secondary-selection ((t (:background "black" :foreground "white" :bold 1)))) (underline ((t (:bold t :underline t)))))))) (defun color-theme-infodoc () "Color theme by Frederic Giroud, created 2001-01-18. Black on wheat scheme. Based on infodoc (xemacs variant distribution), with my favorit fontlock color." (interactive) (color-theme-install '(color-theme-infodoc ((background-color . "wheat") (background-mode . light) (background-toolbar-color . "#000000000000") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#000000000000") (cursor-color . "red") (foreground-color . "black") (top-toolbar-shadow-color . "#ffffffffffff")) nil (default ((t (:bold t)))) (blue ((t (:bold t :foreground "blue")))) (bold ((t (:background "wheat" :foreground "black")))) (bold-italic ((t (:bold t :background "wheat" :foreground "black")))) (border-glyph ((t (:bold t)))) (calendar-today-face ((t (:underline t :bold t)))) (custom-button-face ((t (nil)))) (custom-changed-face ((t (:bold t :background "blue" :foreground "white")))) (custom-documentation-face ((t (:bold t :background "wheat" :foreground "purple4")))) (custom-face-tag-face ((t (:underline t :bold t)))) (custom-group-tag-face ((t (:underline t :bold t :background "wheat" :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :bold t :background "wheat" :foreground "red")))) (custom-invalid-face ((t (:bold t :background "red" :foreground "yellow")))) (custom-modified-face ((t (:bold t :background "blue" :foreground "white")))) (custom-rogue-face ((t (:bold t :background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t :bold t)))) (custom-set-face ((t (:bold t :background "white" :foreground "blue")))) (custom-state-face ((t (:bold t :background "wheat" :foreground "dark green")))) (custom-variable-button-face ((t (:underline t)))) (custom-variable-tag-face ((t (:underline t :bold t :background "wheat" :foreground "blue")))) (diary-face ((t (:bold t :foreground "red")))) (display-time-mail-balloon-enhance-face ((t (:bold t :background "wheat" :foreground "black")))) (display-time-mail-balloon-gnus-group-face ((t (:bold t :background "wheat" :foreground "blue")))) (display-time-time-balloon-face ((t (:bold t :background "light salmon" :foreground "dark green")))) (font-lock-comment-face ((t (:bold t :background "wheat" :foreground "turquoise4")))) (font-lock-doc-string-face ((t (:bold t :background "wheat" :foreground "purple4")))) (font-lock-function-name-face ((t (:bold t :background "wheat" :foreground "blue4")))) (font-lock-keyword-face ((t (:bold t :background "wheat" :foreground "dark orchid")))) (font-lock-preprocessor-face ((t (:bold t :background "wheat" :foreground "orchid4")))) (font-lock-reference-face ((t (:bold t :background "wheat" :foreground "red3")))) (font-lock-string-face ((t (:bold t :background "wheat" :foreground "dark goldenrod")))) (font-lock-type-face ((t (:bold t :background "wheat" :foreground "brown")))) (font-lock-variable-name-face ((t (:bold t :background "wheat" :foreground "chocolate")))) (font-lock-warning-face ((t (:bold t :background "wheat" :foreground "black")))) (gdb-arrow-face ((t (:bold t :background "LightGreen" :foreground "black")))) (green ((t (:bold t :foreground "green")))) (gui-button-face ((t (:bold t :background "wheat" :foreground "red")))) (gui-element ((t (:bold t :background "wheat" :foreground "black")))) (highlight ((t (:bold t :background "darkseagreen2" :foreground "dark green")))) (holiday-face ((t (:bold t :background "pink" :foreground "black")))) (hproperty:but-face ((t (:bold t :background "wheat" :foreground "medium violet red")))) (hproperty:flash-face ((t (:bold t :background "wheat" :foreground "gray80")))) (hproperty:highlight-face ((t (:bold t :background "wheat" :foreground "red")))) (hproperty:item-face ((t (:bold t)))) (isearch ((t (:bold t :background "pale turquoise" :foreground "blue")))) (italic ((t (:bold t :background "wheat" :foreground "black")))) (left-margin ((t (:bold t :background "wheat" :foreground "black")))) (list-mode-item-selected ((t (:bold t :background "gray68" :foreground "black")))) (message-cited-text ((t (:bold t :background "wheat" :foreground "brown")))) (message-header-contents ((t (:bold t :background "wheat" :foreground "black")))) (message-headers ((t (:bold t :background "wheat" :foreground "black")))) (message-highlighted-header-contents ((t (:bold t :background "wheat" :foreground "blue")))) (message-url ((t (nil)))) (modeline ((t (:bold t :background "light salmon" :foreground "dark green")))) (modeline-buffer-id ((t (:bold t :background "light salmon" :foreground "blue4")))) (modeline-mousable ((t (:bold t :background "light salmon" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:bold t :background "light salmon" :foreground "green4")))) (pointer ((t (:bold t :background "wheat" :foreground "red")))) (primary-selection ((t (:bold t :background "medium sea green")))) (red ((t (:bold t :foreground "red")))) (right-margin ((t (:bold t :background "wheat" :foreground "black")))) (secondary-selection ((t (:bold t :background "paleturquoise" :foreground "black")))) (shell-input-face ((t (:bold t :background "wheat" :foreground "blue")))) (shell-option-face ((t (:bold t :background "wheat" :foreground "turquoise4")))) (shell-output-2-face ((t (:bold t :background "wheat" :foreground "dark goldenrod")))) (shell-output-3-face ((t (:bold t :background "wheat" :foreground "dark goldenrod")))) (shell-output-face ((t (:bold t :background "wheat" :foreground "black")))) (shell-prompt-face ((t (:bold t :background "wheat" :foreground "dark orchid")))) (text-cursor ((t (:bold t :background "red" :foreground "wheat")))) (toolbar ((t (:bold t :background "wheat" :foreground "black")))) (underline ((t (:underline t :bold t :background "wheat" :foreground "black")))) (vertical-divider ((t (:bold t)))) (widget-button-face ((t (nil)))) (widget-button-pressed-face ((t (:bold t :background "wheat" :foreground "red")))) (widget-documentation-face ((t (:bold t :background "wheat" :foreground "dark green")))) (widget-field-face ((t (:bold t :background "gray85")))) (widget-inactive-face ((t (:bold t :background "wheat" :foreground "dim gray")))) (x-face ((t (:bold t :background "wheat" :foreground "black")))) (yellow ((t (:bold t :foreground "yellow")))) (zmacs-region ((t (:bold t :background "lightyellow" :foreground "darkgreen"))))))) (defun color-theme-classic () "Color theme by Frederic Giroud, created 2001-01-18. AntiqueWhite on darkslategrey scheme. Based on Gnome 2, with my favorit color foreground-color and fontlock color." (interactive) (color-theme-blue-gnus) (let ((color-theme-is-cumulative t)) (color-theme-install '(color-theme-classic ((foreground-color . "AntiqueWhite") (background-color . "darkslategrey") (mouse-color . "Grey") (cursor-color . "Red") (border-color . "black") (background-mode . dark)) ((apropos-keybinding-face . underline) (apropos-label-face . italic) (apropos-match-face . secondary-selection) (apropos-property-face . bold-italic) (apropos-symbol-face . info-xref) (goto-address-mail-face . message-header-to-face) (goto-address-mail-mouse-face . secondary-selection) (goto-address-url-face . info-xref) (goto-address-url-mouse-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (default ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t :foreground "beige")))) (calendar-today-face ((t (:underline t)))) (cperl-array-face ((t (:foreground "Yellow")))) (cperl-hash-face ((t (:foreground "White")))) (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) (custom-button-face ((t (:underline t :foreground "MediumSlateBlue")))) (custom-documentation-face ((t (:foreground "Grey")))) (custom-group-tag-face ((t (:foreground "MediumAquamarine")))) (custom-state-face ((t (:foreground "LightSalmon")))) (custom-variable-tag-face ((t (:foreground "Aquamarine")))) (diary-face ((t (:foreground "IndianRed")))) (erc-action-face ((t (:bold t)))) (erc-bold-face ((t (:bold t)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "LightSalmon")))) (erc-error-face ((t (:bold t :foreground "IndianRed")))) (erc-input-face ((t (:foreground "Beige")))) (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) (erc-notice-face ((t (:foreground "MediumAquamarine")))) (erc-pal-face ((t (:foreground "pale green")))) (erc-prompt-face ((t (:foreground "MediumAquamarine")))) (erc-underline-face ((t (:underline t)))) (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) (eshell-ls-backup-face ((t (:foreground "Grey")))) (eshell-ls-clutter-face ((t (:foreground "DimGray")))) (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue")))) (eshell-ls-executable-face ((t (:foreground "Coral")))) (eshell-ls-missing-face ((t (:foreground "black")))) (eshell-ls-picture-face ((t (:foreground "Violet")))) (eshell-ls-product-face ((t (:foreground "LightSalmon")))) (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) (eshell-ls-special-face ((t (:foreground "Gold")))) (eshell-ls-symlink-face ((t (:foreground "White")))) (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) (eshell-prompt-face ((t (:foreground "MediumAquamarine")))) (font-lock-builtin-face ((t (:bold t :foreground "PaleGreen")))) (font-lock-comment-face ((t (:foreground "tomato3")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-doc-string-face ((t (:foreground "LightSalmon3")))) (font-lock-function-name-face ((t (:foreground "SteelBlue1")))) (font-lock-keyword-face ((t (:foreground "cyan1")))) (font-lock-reference-face ((t (:foreground "LightSalmon2")))) (font-lock-string-face ((t (:foreground "LightSalmon3")))) (font-lock-type-face ((t (:foreground "PaleGreen3")))) (font-lock-variable-name-face ((t (:foreground "khaki1")))) (font-lock-warning-face ((t (:bold t :foreground "IndianRed")))) (font-lock-preprocessor-face ((t (:foreground "SkyBlue3")))) (widget-field-face ((t (:background "DarkCyan")))) (custom-group-tag-face ((t(:foreground "brown" :underline t)))) (custom-state-face ((t (:foreground "khaki")))) (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) (highline-face ((t (:background "SeaGreen")))) (holiday-face ((t (:background "DimGray")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:underline t :bold t :foreground "DodgerBlue1")))) (info-xref ((t (:underline t :foreground "DodgerBlue1")))) (isearch ((t (:foreground "red" :background "CornflowerBlue")))) (italic ((t (:italic t)))) (modeline ((t (:background "LightSlateGray" :foreground "AntiqueWhite")))) (modeline-buffer-id ((t (:background "LightSlateGray" :foreground "DarkBlue")))) (modeline-mousable ((t (:background "LightSlateGray" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:background "LightSlateGray" :foreground "wheat")))) (region ((t (:background "dark cyan" :foreground "cyan")))) (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) (show-paren-match-face ((t (:background "Aquamarine" :foreground "SlateBlue")))) (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) (underline ((t (:underline t)))) (widget-field-face ((t (:foreground "LightBlue")))) (widget-inactive-face ((t (:foreground "DimGray")))) (widget-single-line-field-face ((t (:foreground "LightBlue")))) (woman-bold-face ((t (:bold t)))) (woman-italic-face ((t (:foreground "beige")))) (woman-unknown-face ((t (:foreground "LightSalmon")))))))) (defun color-theme-scintilla () "Color theme by Gordon Messmer, created 2001-02-07. Based on the Scintilla editor. If you want to modify the font as well, you should customize variable `color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". The default setting will prevent color themes from installing specific fonts." (interactive) (color-theme-install ;; The light editor style doesn't seem to look right with ;; the same font that works in the dark editor style. ;; Dark letters on light background just isn't as visible. '(color-theme-scintilla ((font . "-monotype-courier new-bold-r-normal-*-*-140-*-*-m-*-iso8859-1") (width . 95) (height . 40) (background-color . "white") (foreground-color . "black") (background-mode . light) (mouse-color . "grey15") (cursor-color . "grey15")) (default ((t nil))) (font-lock-comment-face ((t (:italic t :foreground "ForestGreen")))) (font-lock-string-face ((t (:foreground "DarkMagenta")))) (font-lock-keyword-face ((t (:foreground "NavyBlue")))) (font-lock-warning-face ((t (:bold t :foreground "VioletRed")))) (font-lock-constant-face ((t (:foreground "Blue")))) (font-lock-type-face ((t (:foreground "NavyBlue")))) (font-lock-variable-name-face ((t (:foreground "DarkCyan")))) (font-lock-function-name-face ((t (:foreground "DarkCyan")))) (font-lock-builtin-face ((t (:foreground "NavyBlue")))) (highline-face ((t (:background "Grey95")))) (show-paren-match-face ((t (:background "Grey80")))) (region ((t (:background "Grey80")))) (highlight ((t (:foreground "ForestGreen")))) (secondary-selection ((t (:background "NavyBlue" :foreground "white")))) (widget-field-face ((t (:background "NavyBlue")))) (widget-single-line-field-face ((t (:background "RoyalBlue")))))) ) (defun color-theme-gtk-ide () "Color theme by Gordon Messmer, created 2001-02-07. Inspired by a GTK IDE whose name I've forgotten. If you want to modify the font as well, you should customize variable `color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". The default setting will prevent color themes from installing specific fonts." ;; The light editor style doesn't seem to look right with ;; the same font that works in the dark editor style. ;; Dark letters on light background just isn't as visible. (interactive) (color-theme-install '(color-theme-gtk-ide ((font . "-monotype-courier new-medium-r-normal-*-*-120-*-*-m-*-iso8859-15") (width . 95) (height . 45) (background-color . "white") (foreground-color . "black") (background-mode . light) (mouse-color . "grey15") (cursor-color . "grey15")) (default ((t nil))) (font-lock-comment-face ((t (:italic t :foreground "grey55")))) (font-lock-string-face ((t (:foreground "DarkRed")))) (font-lock-keyword-face ((t (:foreground "DarkBlue")))) (font-lock-warning-face ((t (:bold t :foreground "VioletRed")))) (font-lock-constant-face ((t (:foreground "OliveDrab")))) (font-lock-type-face ((t (:foreground "SteelBlue4")))) (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) (font-lock-function-name-face ((t (:foreground "SlateBlue")))) (font-lock-builtin-face ((t (:foreground "ForestGreen")))) (highline-face ((t (:background "grey95")))) (show-paren-match-face ((t (:background "grey80")))) (region ((t (:background "grey80")))) (highlight ((t (:background "LightSkyBlue")))) (secondary-selection ((t (:background "grey55")))) (widget-field-face ((t (:background "navy")))) (widget-single-line-field-face ((t (:background "royalblue")))))) ) (defun color-theme-midnight () "Color theme by Gordon Messmer, created 2001-02-07. A color theme inspired by a certain IDE for Windows. It's all from memory, since I only used that software in college. If you want to modify the font as well, you should customize variable `color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". The default setting will prevent color themes from installing specific fonts." (interactive) (color-theme-install '(color-theme-midnight ((font . "fixed") (width . 130) (height . 50) (background-color . "black") (foreground-color . "grey85") (background-mode . dark) (mouse-color . "grey85") (cursor-color . "grey85")) (default ((t (nil)))) (font-lock-comment-face ((t (:italic t :foreground "grey60")))) (font-lock-string-face ((t (:foreground "Magenta")))) (font-lock-keyword-face ((t (:foreground "Cyan")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (font-lock-constant-face ((t (:foreground "OliveDrab")))) (font-lock-type-face ((t (:foreground "DarkCyan")))) (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) (font-lock-function-name-face ((t (:foreground "SlateBlue")))) (font-lock-builtin-face ((t (:foreground "SkyBlue")))) (highline-face ((t (:background "grey12")))) (setnu-line-number-face ((t (:background "Grey15" :foreground "White" :bold t)))) (show-paren-match-face ((t (:background "grey30")))) (region ((t (:background "grey15")))) (highlight ((t (:background "blue")))) (secondary-selection ((t (:background "navy")))) (widget-field-face ((t (:background "navy")))) (widget-single-line-field-face ((t (:background "royalblue")))))) ) (defun color-theme-jedit-grey () "Color theme by Gordon Messmer, created 2001-02-07. Based on a screenshot of jedit. If you want to modify the font as well, you should customize variable `color-theme-legal-frame-parameters' to \"\\(color\\|mode\\|font\\|height\\|width\\)$\". The default setting will prevent color themes from installing specific fonts." (interactive) (color-theme-install '(color-theme-jedit-grey ((font . "fixed") (width . 130) (height . 50) (background-color . "grey77") (foreground-color . "black") (background-mode . light) (mouse-color . "black") (cursor-color . "black")) (default ((t (nil)))) (font-lock-comment-face ((t (:italic t :foreground "RoyalBlue4")))) (font-lock-string-face ((t (:foreground "Gold4")))) (font-lock-keyword-face ((t (:bold t :foreground "DarkRed")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (font-lock-constant-face ((t (:foreground "DarkCyan")))) (font-lock-type-face ((t (:foreground "DarkRed")))) (font-lock-function-name-face ((t (:foreground "Green4")))) (font-lock-builtin-face ((t (:bold t :foreground "DarkRed")))) (highline-face ((t (:background "grey84")))) (setnu-line-number-face ((t (:background "White" :foreground "MediumPurple3" :italic t)))) (show-paren-match-face ((t (:background "grey60")))) (region ((t (:background "grey70")))) (highlight ((t (:background "grey90")))) (secondary-selection ((t (:background "white")))) (widget-field-face ((t (:background "royalblue")))) (widget-single-line-field-face ((t (:background "royalblue")))))) ) (defun color-theme-snow () "Color theme by Nicolas Rist, created 2001-03-08. Black on gainsboro. In Emacs, the text background is a shade darker than the frame background: Gainsboro instead of snow. This makes the structure of the text clearer without being too agressive on the eyes. On XEmacs, this doesn't really work as the frame and the default face allways use the same foreground and background colors. The color theme includes gnus, message, font-lock, sgml, and speedbar." (interactive) (color-theme-install '(color-theme-snow ((background-color . "snow2") (background-mode . light) (border-color . "black") (cursor-color . "RoyalBlue2") (foreground-color . "black") (mouse-color . "black")) ((gnus-mouse-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (default ((t (:background "gainsboro" :foreground "dark slate gray")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (calendar-today-face ((t (:underline t)))) (custom-button-face ((t (:background "gainsboro" :foreground "dark cyan")))) (custom-documentation-face ((t (:background "gainsboro")))) (diary-face ((t (:foreground "red")))) (fg:black ((t (:foreground "black")))) (font-lock-builtin-face ((t (:background "gainsboro" :foreground "medium orchid")))) (font-lock-comment-face ((t (:background "gainsboro" :foreground "SteelBlue3")))) (font-lock-constant-face ((t (:background "gainsboro" :foreground "orange3")))) (font-lock-function-name-face ((t (:background "gainsboro" :foreground "blue3")))) (font-lock-keyword-face ((t (:background "gainsboro" :foreground "red3")))) (font-lock-string-face ((t (:background "gainsboro" :foreground "SpringGreen3")))) (font-lock-type-face ((t (:background "gainsboro" :foreground "dark cyan")))) (font-lock-variable-name-face ((t (:background "gainsboro" :foreground "purple2")))) (font-lock-warning-face ((t (:bold t :background "gainsboro" :foreground "red")))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-splash-face ((t (:foreground "ForestGreen")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (gui-button-face ((t (:foreground "light grey")))) (highlight ((t (:background "LightSteelBlue1")))) (holiday-face ((t (:background "pink")))) (ibuffer-marked-face ((t (:foreground "red")))) (italic ((t (:italic t)))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:background "dark slate gray" :foreground "gainsboro")))) (modeline-buffer-id ((t (:background "dark slate gray" :foreground "gainsboro")))) (modeline-mousable ((t (:background "dark slate gray" :foreground "gainsboro")))) (modeline-mousable-minor-mode ((t (:background "dark slate gray" :foreground "gainsboro")))) (region ((t (:background "lavender")))) (secondary-selection ((t (:background "paleturquoise")))) (sgml-comment-face ((t (:foreground "dark green")))) (sgml-doctype-face ((t (:foreground "maroon")))) (sgml-end-tag-face ((t (:foreground "blue2")))) (sgml-entity-face ((t (:foreground "red2")))) (sgml-ignored-face ((t (:background "gray90" :foreground "maroon")))) (sgml-ms-end-face ((t (:foreground "maroon")))) (sgml-ms-start-face ((t (:foreground "maroon")))) (sgml-pi-face ((t (:foreground "maroon")))) (sgml-sgml-face ((t (:foreground "maroon")))) (sgml-short-ref-face ((t (:foreground "goldenrod")))) (sgml-start-tag-face ((t (:foreground "blue2")))) (show-paren-match-face ((t (:background "SlateGray1")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "dark turquoise" :foreground "white")))) (speedbar-selected-face ((t (:underline t :foreground "red")))) (speedbar-tag-face ((t (:foreground "brown")))) (underline ((t (:underline t))))))) (defun color-theme-montz () "Color theme by Brady Montz, created 2001-03-08. Black on Gray. Includes dired, bbdb, font-lock, gnus, message, viper, and widget." (interactive) (color-theme-install '(color-theme-montz ((background-color . "gray80") (background-mode . light) (background-toolbar-color . "#cccccccccccc") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#7a7a7a7a7a7a") (cursor-color . "Red3") (foreground-color . "black") (top-toolbar-shadow-color . "#f5f5f5f5f5f5") (viper-saved-cursor-color-in-replace-mode . "Red3")) ((gnus-mouse-face . highlight) (paren-match-face . paren-face-match) (paren-mismatch-face . paren-face-mismatch) (paren-no-match-face . paren-face-no-match) (smiley-mouse-face . highlight)) (default ((t (nil)))) (bbdb-company ((t (:italic t)))) (bbdb-field-name ((t (:bold t)))) (bbdb-field-value ((t (nil)))) (bbdb-name ((t (:underline t)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (border-glyph ((t (nil)))) (dired-face-boring ((t (:foreground "Gray65")))) (dired-face-directory ((t (:bold t)))) (dired-face-executable ((t (:foreground "SeaGreen")))) (dired-face-flagged ((t (:background "LightSlateGray")))) (dired-face-marked ((t (:background "PaleVioletRed")))) (dired-face-permissions ((t (:background "grey75" :foreground "black")))) (dired-face-setuid ((t (:foreground "Red")))) (dired-face-socket ((t (:foreground "magenta")))) (dired-face-symlink ((t (:foreground "cyan")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "red")))) (font-lock-builtin-face ((t (:foreground "red3")))) (font-lock-comment-face ((t (:foreground "blue")))) (font-lock-constant-face ((t (:foreground "red3")))) (font-lock-doc-string-face ((t (:foreground "mediumvioletred")))) (font-lock-function-name-face ((t (:foreground "firebrick")))) (font-lock-keyword-face ((t (:bold t :foreground "black")))) (font-lock-preprocessor-face ((t (:foreground "blue3")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (:foreground "mediumvioletred")))) (font-lock-type-face ((t (:foreground "darkgreen")))) (font-lock-variable-name-face ((t (:foreground "black")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (gnus-cite-attribution-face ((t (:italic t)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:bold t)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) (gnus-header-from-face ((t (:foreground "red3")))) (gnus-header-name-face ((t (:foreground "maroon")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) (gnus-header-subject-face ((t (:foreground "red4")))) (gnus-picons-face ((t (:background "white" :foreground "black")))) (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) (gnus-signature-face ((t (:italic t)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (gnus-x-face ((t (:background "white" :foreground "black")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (nil)))) (highlight ((t (:background "darkseagreen2")))) (info-node ((t (:bold t)))) (info-xref ((t (:bold t)))) (isearch ((t (:background "paleturquoise")))) (italic ((t (:italic t)))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68" :foreground "black")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (nil)))) (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) (paren-face-match ((t (:background "turquoise")))) (paren-face-mismatch ((t (:background "purple" :foreground "white")))) (paren-face-no-match ((t (:background "yellow" :foreground "black")))) (pointer ((t (nil)))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "paleturquoise")))) (text-cursor ((t (:background "Red3" :foreground "gray80")))) (toolbar ((t (nil)))) (underline ((t (:underline t)))) (vertical-divider ((t (nil)))) (viper-minibuffer-emacs-face ((t (:background "gray80" :foreground "black")))) (viper-minibuffer-insert-face ((t (:background "gray80" :foreground "black")))) (viper-minibuffer-vi-face ((t (:background "gray80" :foreground "black")))) (viper-replace-overlay-face ((t (:background "black" :foreground "white")))) (viper-search-face ((t (:background "black" :foreground "white")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "black" :foreground "white"))))))) (defun color-theme-aalto-light () "Color theme by Jari Aalto, created 2001-03-08. Black on light yellow. Used for Win32 on a Nokia446Xpro monitor. Includes cvs, font-lock, gnus, message, sgml, widget" (interactive) (color-theme-install '(color-theme-aalto-light ((background-color . "#FFFFE0") (background-mode . light) (border-color . "black") (cursor-color . "black") (foreground-color . "black") (mouse-color . "LawnGreen")) ((gnus-mouse-face . highlight) (list-matching-lines-face . bold) (tinyreplace-:face . highlight) (view-highlight-face . highlight)) (default ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (calendar-today-face ((t (:underline t)))) (cvs-filename-face ((t (:foreground "blue4")))) (cvs-handled-face ((t (:foreground "pink")))) (cvs-header-face ((t (:bold t :foreground "blue4")))) (cvs-marked-face ((t (:bold t :foreground "green3")))) (cvs-msg-face ((t (:italic t)))) (cvs-need-action-face ((t (:foreground "orange")))) (cvs-unknown-face ((t (:foreground "red")))) (diary-face ((t (:foreground "red")))) (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) (eshell-test-ok-face ((t (:bold t :foreground "Green")))) (font-lock-builtin-face ((t (:foreground "Orchid")))) (font-lock-comment-face ((t (:foreground "Firebrick")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-function-name-face ((t (:foreground "Blue")))) (font-lock-keyword-face ((t (:foreground "Purple")))) (font-lock-string-face ((t (:foreground "RosyBrown")))) (font-lock-type-face ((t (:foreground "ForestGreen")))) (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) (gnus-header-from-face ((t (:foreground "red3")))) (gnus-header-name-face ((t (:foreground "maroon")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) (gnus-header-subject-face ((t (:foreground "red4")))) (gnus-signature-face ((t (:italic t)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (highlight ((t (:background "darkseagreen2")))) (holiday-face ((t (:background "pink")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:italic t :bold t)))) (info-xref ((t (:bold t)))) (italic ((t (:italic t)))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:background "black" :foreground "white")))) (modeline-buffer-id ((t (:background "black" :foreground "white")))) (modeline-mousable ((t (:background "black" :foreground "white")))) (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) (region ((t (:background "gray")))) (secondary-selection ((t (:background "paleturquoise")))) (sgml-comment-face ((t (:foreground "dark turquoise")))) (sgml-doctype-face ((t (:foreground "red")))) (sgml-end-tag-face ((t (:foreground "blue")))) (sgml-entity-face ((t (:foreground "magenta")))) (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) (sgml-ms-end-face ((t (:foreground "green")))) (sgml-ms-start-face ((t (:foreground "green")))) (sgml-pi-face ((t (:foreground "lime green")))) (sgml-sgml-face ((t (:foreground "brown")))) (sgml-short-ref-face ((t (:foreground "deep sky blue")))) (sgml-start-tag-face ((t (:foreground "blue")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (underline ((t (:underline t)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85"))))))) (defun color-theme-aalto-dark () "Color theme by Jari Aalto, created 2001-03-08. White on Deep Sky Blue 3. Used for Unix Exceed on a Nokia446Xpro monitor. Includes font-lock, info, and message." (interactive) (color-theme-install '(color-theme-aalto-dark ((background-color . "DeepSkyBlue3") (background-mode . dark) (border-color . "black") (cursor-color . "yellow") (foreground-color . "white") (mouse-color . "black")) ((ispell-highlight-face . highlight) (list-matching-lines-face . bold) (tinyreplace-:face . highlight) (view-highlight-face . highlight)) (default ((t (nil)))) (bold ((t (:bold t :background "blue3" :foreground "white")))) (bold-italic ((t (:italic t :bold t :foreground "blue3")))) (calendar-today-face ((t (:underline t)))) (diary-face ((t (:foreground "red")))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:foreground "OrangeRed")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) (font-lock-keyword-face ((t (:foreground "Cyan")))) (font-lock-string-face ((t (:foreground "LightSalmon")))) (font-lock-type-face ((t (:foreground "PaleGreen")))) (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (highlight ((t (:background "blue3" :foreground "white")))) (holiday-face ((t (:background "pink")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:italic t :bold t)))) (info-xref ((t (:bold t)))) (italic ((t (:italic t :background "gray")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "green4")))) (message-header-name-face ((t (:foreground "DarkGreen")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) (message-header-other-face ((t (:foreground "#b00000")))) (message-header-subject-face ((t (:foreground "green3")))) (message-header-to-face ((t (:bold t :foreground "green2")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "blue3")))) (modeline ((t (:background "white" :foreground "DeepSkyBlue3")))) (modeline-buffer-id ((t (:background "white" :foreground "DeepSkyBlue3")))) (modeline-mousable ((t (:background "white" :foreground "DeepSkyBlue3")))) (modeline-mousable-minor-mode ((t (:background "white" :foreground "DeepSkyBlue3")))) (region ((t (:background "gray")))) (secondary-selection ((t (:background "darkslateblue")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (underline ((t (:underline t))))))) (defun color-theme-blippblopp () "Color theme by Thomas Sicheritz-Ponten, created 2001-03-12. Used by researchers at Uppsala University and the Center for Biological Sequence Analysis at the Technical University of Denmark. (As some of my swedish friends couldn't pronounce Sicheritz - they choose to transform it to something more \"swedish\": Blippblopp :-) Includes font-lock and message." (interactive) (color-theme-install '(color-theme-blippblopp ((background-color . "white") (background-mode . light) (background-toolbar-color . "#cf3ccf3ccf3c") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#79e77df779e7") (cursor-color . "Red3") (foreground-color . "black") (mouse-color . "black") (top-toolbar-shadow-color . "#fffffbeeffff") (viper-saved-cursor-color-in-replace-mode . "Red3")) ((ispell-highlight-face . highlight)) (default ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (excerpt ((t (:italic t)))) (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) (fg:black ((t (:foreground "black")))) (fixed ((t (:bold t)))) (font-lock-builtin-face ((t (:foreground "red3")))) (font-lock-comment-face ((t (:foreground "orange")))) (font-lock-constant-face ((t (:foreground "red3")))) (font-lock-doc-string-face ((t (:foreground "darkgreen")))) (font-lock-exit-face ((t (:foreground "green")))) (font-lock-function-name-face ((t (:bold t :foreground "red")))) (font-lock-keyword-face ((t (:bold t :foreground "steelblue")))) (font-lock-preprocessor-face ((t (:foreground "blue3")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (:foreground "green4")))) (font-lock-type-face ((t (:bold t :foreground "blue")))) (font-lock-variable-name-face ((t (:foreground "black")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (green ((t (:foreground "green")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:background "dimgray" :foreground "lemonchiffon")))) (modeline-buffer-id ((t (:background "dimgray" :foreground "green3")))) (modeline-mousable ((t (:background "dimgray" :foreground "orange")))) (modeline-mousable-minor-mode ((t (:background "dimgray" :foreground "blue4")))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (region ((t (:background "gray65")))) (secondary-selection ((t (:background "paleturquoise")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (text-cursor ((t (:background "Red3" :foreground "white")))) (toolbar ((t (:background "Gray80")))) (underline ((t (:underline t)))) (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) (vertical-divider ((t (:background "Gray80")))) (xref-keyword-face ((t (:foreground "blue")))) (xref-list-pilot-face ((t (:foreground "navy")))) (xref-list-symbol-face ((t (:foreground "navy")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "gray65"))))))) (defun color-theme-hober (&optional preview) "Does all sorts of crazy stuff. Originally based on color-theme-standard, so I probably still have some setting that I haven't changed. I also liberally copied settings from the other themes in this package. The end result isn't much like the other ones; I hope you like it." (interactive) (color-theme-install '(color-theme-hober ((foreground-color . "#c0c0c0") (background-color . "black") (mouse-color . "black") (cursor-color . "medium turquoise") (border-color . "black") (background-mode . dark)) (default ((t (nil)))) (modeline ((t (:foreground "white" :background "darkslateblue")))) (modeline-buffer-id ((t (:foreground "white" :background "darkslateblue")))) (modeline-mousable ((t (:foreground "white" :background "darkslateblue")))) (modeline-mousable-minor-mode ((t (:foreground "white" :background "darkslateblue")))) (highlight ((t (:foreground "black" :background "#c0c0c0")))) (bold ((t (:bold t)))) (italic ((t (:italic t)))) (bold-italic ((t (:bold t :italic t)))) (region ((t (:foreground "white" :background "darkslateblue")))) (zmacs-region ((t (:foreground "white" :background "darkslateblue")))) (secondary-selection ((t (:background "paleturquoise")))) (underline ((t (:underline t)))) (diary-face ((t (:foreground "red")))) (calendar-today-face ((t (:underline t)))) (holiday-face ((t (:background "pink")))) (widget-documentation-face ((t (:foreground "dark green" :background "white")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red" :background "black")))) (widget-field-face ((t (:background "gray85" :foreground "black")))) (widget-single-line-field-face ((t (:background "gray85" :foreground "black")))) (widget-inactive-face ((t (:foreground "dim gray" :background "red")))) (fixed ((t (:bold t)))) (excerpt ((t (:italic t)))) (term-default-fg ((t (nil)))) (term-default-bg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-bold ((t (:bold t)))) (term-underline ((t (:underline t)))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-white ((t (:foreground "#c0c0c0")))) (term-whitebg ((t (:background "#c0c0c0")))) (term-black ((t (:foreground "black")))) (term-blackbg ((t (:background "black")))) (term-red ((t (:foreground "#ef8171")))) (term-redbg ((t (:background "#ef8171")))) (term-green ((t (:foreground "#e5f779")))) (term-greenbg ((t (:background "#e5f779")))) (term-yellow ((t (:foreground "#fff796")))) (term-yellowbg ((t (:background "#fff796")))) (term-blue ((t (:foreground "#4186be")))) (term-bluebg ((t (:background "#4186be")))) (term-magenta ((t (:foreground "#ef9ebe")))) (term-magentabg ((t (:background "#ef9ebe")))) (term-cyan ((t (:foreground "#71bebe")))) (term-cyanbg ((t (:background "#71bebe")))) (font-lock-keyword-face ((t (:foreground "#00ffff")))) (font-lock-comment-face ((t (:foreground "Red")))) (font-lock-string-face ((t (:foreground "#ffff00")))) (font-lock-constant-face ((t (:foreground "#00ff00")))) (font-lock-builtin-face ((t (:foreground "#ffaa00")))) (font-lock-type-face ((t (:foreground "Coral")))) (font-lock-warning-face ((t (:foreground "Red" :bold t)))) (font-lock-function-name-face ((t (:foreground "#4186be")))) (font-lock-variable-name-face ((t (:foreground "white" :bold t)))) (message-header-to-face ((t (:foreground "#4186be" :bold t)))) (message-header-cc-face ((t (:foreground "#4186be")))) (message-header-subject-face ((t (:foreground "#4186be" :bold t)))) (message-header-newsgroups-face ((t (:foreground "Coral" :bold t)))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-name-face ((t (:foreground "white")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-separator-face ((t (:foreground "brown")))) (message-cited-text-face ((t (:foreground "white")))) (gnus-header-from-face ((t (:foreground "Coral")))) (gnus-header-subject-face ((t (:foreground "#4186be")))) (gnus-header-newsgroups-face ((t (:foreground "#4186be" :italic t)))) (gnus-header-name-face ((t (:foreground "white")))) (gnus-header-content-face ((t (:foreground "#4186be" :italic t)))) (gnus-cite-attribution-face ((t (:italic t)))) (gnus-cite-face-list ((t (:bold nil :foreground "red")))) (gnus-group-news-1-face ((t (:foreground "ForestGreen" :bold t)))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-2-face ((t (:foreground "CadetBlue4" :bold t)))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-low-face ((t (:foreground "DarkGreen" :bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-mail-1-face ((t (:foreground "DeepPink3" :bold t)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-2-face ((t (:foreground "HotPink3" :bold t)))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-3-face ((t (:foreground "magenta4" :bold t)))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-low-face ((t (:foreground "DeepPink4" :bold t)))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-summary-selected-face ((t (:underline t)))) (gnus-summary-cancelled-face ((t (:foreground "yellow" :background "black")))) (gnus-summary-high-ticked-face ((t (:foreground "firebrick" :bold t)))) (gnus-summary-low-ticked-face ((t (:foreground "firebrick" :italic t)))) (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-high-ancient-face ((t (:foreground "RoyalBlue" :bold t)))) (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue" :italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-high-read-face ((t (:foreground "DarkGreen" :bold t)))) (gnus-summary-low-read-face ((t (:foreground "DarkGreen" :italic t)))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-splash-face ((t (:foreground "ForestGreen")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t)))) (gnus-emphasis-bold-italic ((t (:bold t :italic t)))) (gnus-emphasis-underline-bold-italic ((t (:bold t :italic t :underline t)))) (gnus-signature-face ((t (:foreground "white")))) (gnus-cite-face-1 ((t (:foreground "Khaki")))) (gnus-cite-face-2 ((t (:foreground "Coral")))) (gnus-cite-face-3 ((t (:foreground "#4186be")))) (gnus-cite-face-4 ((t (:foreground "yellow green")))) (gnus-cite-face-5 ((t (:foreground "IndianRed")))) (highlight-changes-face ((t (:foreground "red")))) (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) (show-paren-match-face ((t (:foreground "white" :background "purple")))) (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (cperl-array-face ((t (:foreground "Blue" :bold t :background "lightyellow2")))) (cperl-hash-face ((t (:foreground "Red" :bold t :italic t :background "lightyellow2")))) (makefile-space-face ((t (:background "hotpink")))) (sgml-start-tag-face ((t (:foreground "mediumspringgreen")))) (sgml-ignored-face ((t (:foreground "gray20" :background "gray60")))) (sgml-doctype-face ((t (:foreground "orange")))) (sgml-sgml-face ((t (:foreground "yellow")))) (sgml-end-tag-face ((t (:foreground "greenyellow")))) (sgml-entity-face ((t (:foreground "gold")))) (flyspell-incorrect-face ((t (:foreground "OrangeRed" :bold t :underline t)))) (flyspell-duplicate-face ((t (:foreground "Gold3" :bold t :underline t))))))) (defun color-theme-bharadwaj () "Color theme by Girish Bharadwaj, created 2001-03-28. Black on gainsboro. Includes BBDB, custom, cperl, cvs, dired, ediff, erc, eshell, font-latex, font-lock, gnus, info, message, paren, sgml, shell, speedbar, term, vhdl, viper, widget, woman, xref. Wow!" (interactive) (color-theme-install '(color-theme-bharadwaj ((background-color . "gainsboro") (background-mode . light) (background-toolbar-color . "#cf3ccf3ccf3c") (border-color . "black") (bottom-toolbar-shadow-color . "#79e77df779e7") (cursor-color . "grey15") (foreground-color . "black") (mouse-color . "grey15") (top-toolbar-shadow-color . "#fffffbeeffff") (viper-saved-cursor-color-in-replace-mode . "Red3")) ((gnus-mouse-face . highlight) (smiley-mouse-face . highlight)) (default ((t (nil)))) (bbdb-company ((t (nil)))) (bbdb-field-name ((t (:bold t)))) (bbdb-field-value ((t (nil)))) (bbdb-name ((t (:underline t)))) (blank-space-face ((t (nil)))) (blank-tab-face ((t (nil)))) (blue ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:bold t)))) (border-glyph ((t (nil)))) (calendar-today-face ((t (:underline t)))) (comint-input-face ((t (:foreground "deepskyblue")))) (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) (cperl-hash-face ((t (:bold t :background "lightyellow2" :foreground "Red")))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (custom-button-face ((t (:bold t)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :bold t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :bold t :foreground "blue")))) (cvs-filename-face ((t (:foreground "blue4")))) (cvs-handled-face ((t (:foreground "pink")))) (cvs-header-face ((t (:bold t :foreground "blue4")))) (cvs-marked-face ((t (:bold t :foreground "green3")))) (cvs-msg-face ((t (nil)))) (cvs-need-action-face ((t (:foreground "orange")))) (cvs-unknown-face ((t (:foreground "red")))) (diary-face ((t (:bold t :foreground "red")))) (dired-face-boring ((t (:foreground "Gray65")))) (dired-face-directory ((t (:bold t :foreground "forestgreen")))) (dired-face-executable ((t (:foreground "indianred")))) (dired-face-flagged ((t (:background "SlateGray")))) (dired-face-marked ((t (:background "darkblue" :foreground "deepskyblue")))) (dired-face-permissions ((t (nil)))) (dired-face-setuid ((t (:foreground "Red")))) (dired-face-socket ((t (:foreground "magenta")))) (dired-face-symlink ((t (:foreground "grey95")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "red")))) (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) (erc-action-face ((t (:bold t)))) (erc-bold-face ((t (:bold t)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (nil)))) (erc-error-face ((t (:bold t)))) (erc-input-face ((t (nil)))) (erc-inverse-face ((t (nil)))) (erc-notice-face ((t (nil)))) (erc-pal-face ((t (nil)))) (erc-prompt-face ((t (nil)))) (erc-underline-face ((t (nil)))) (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) (eshell-ls-picture-face ((t (nil)))) (eshell-ls-product-face ((t (:foreground "OrangeRed")))) (eshell-ls-readonly-face ((t (:foreground "Brown")))) (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) (eshell-prompt-face ((t (:bold t :foreground "Red")))) (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) (eshell-test-ok-face ((t (:bold t :foreground "Green")))) (excerpt ((t (nil)))) (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) (fg:black ((t (:foreground "black")))) (fixed ((t (:bold t)))) (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) (font-latex-bold-face ((t (nil)))) (font-latex-italic-face ((t (nil)))) (font-latex-math-face ((t (nil)))) (font-latex-sedate-face ((t (nil)))) (font-latex-string-face ((t (nil)))) (font-latex-warning-face ((t (nil)))) (font-lock-builtin-face ((t (:foreground "ForestGreen")))) (font-lock-comment-face ((t (:foreground "grey55")))) (font-lock-constant-face ((t (:foreground "OliveDrab")))) (font-lock-doc-string-face ((t (:bold t :foreground "blue4")))) (font-lock-exit-face ((t (nil)))) (font-lock-function-name-face ((t (:italic t :bold t :foreground "SlateBlue")))) (font-lock-keyword-face ((t (:foreground "DarkBlue")))) (font-lock-preprocessor-face ((t (:foreground "blue3")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (:foreground "DarkRed")))) (font-lock-type-face ((t (:foreground "SteelBlue4")))) (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "VioletRed")))) (fringe ((t (:background "grey95")))) (gnus-cite-attribution-face ((t (:bold t)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:bold t)))) (gnus-emphasis-highlight-words ((t (nil)))) (gnus-emphasis-italic ((t (nil)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t)))) (gnus-filterhist-face-1 ((t (nil)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-header-content-face ((t (:foreground "indianred4")))) (gnus-header-from-face ((t (:bold t :foreground "red3")))) (gnus-header-name-face ((t (:bold t :foreground "maroon")))) (gnus-header-newsgroups-face ((t (:bold t :foreground "MidnightBlue")))) (gnus-header-subject-face ((t (:bold t :foreground "red4")))) (gnus-picons-face ((t (:background "white" :foreground "black")))) (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) (gnus-signature-face ((t (nil)))) (gnus-splash ((t (nil)))) (gnus-splash-face ((t (:foreground "ForestGreen")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-low-unread-face ((t (nil)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (:bold t)))) (gnus-summary-selected-face ((t (:underline t)))) (gnus-x-face ((t (:background "white" :foreground "black")))) (green ((t (nil)))) (gui-button-face ((t (:background "grey75")))) (gui-element ((t (:background "Gray80")))) (highlight ((t (:background "LightSkyBlue")))) (highlight-changes-delete-face ((t (:underline t :foreground "red")))) (highlight-changes-face ((t (:foreground "red")))) (highline-face ((t (:background "grey95")))) (holiday-face ((t (:background "pink")))) (html-helper-italic-face ((t (nil)))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:bold t)))) (info-xref ((t (:bold t)))) (isearch ((t (:background "yellow")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (nil)))) (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) (left-margin ((t (nil)))) (linemenu-face ((t (nil)))) (list-mode-item-selected ((t (nil)))) (makefile-space-face ((t (:background "hotpink")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:bold t)))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:background "white" :foreground "black")))) (modeline-buffer-id ((t (:background "white" :foreground "black")))) (modeline-mousable ((t (:background "white" :foreground "black")))) (modeline-mousable-minor-mode ((t (:background "white" :foreground "black")))) (paren-blink-off ((t (:foreground "gray80")))) (paren-face-match ((t (:background "turquoise")))) (paren-face-mismatch ((t (:background "purple" :foreground "white")))) (paren-face-no-match ((t (:background "yellow" :foreground "black")))) (paren-match ((t (:background "darkseagreen2")))) (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) (paren-mismatch-face ((t (:bold t)))) (paren-no-match-face ((t (:bold t)))) (pointer ((t (nil)))) (primary-selection ((t (nil)))) (red ((t (nil)))) (region ((t (:background "grey80")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "grey55")))) (sgml-comment-face ((t (:foreground "dark turquoise")))) (sgml-doctype-face ((t (nil)))) (sgml-end-tag-face ((t (nil)))) (sgml-entity-face ((t (nil)))) (sgml-ignored-face ((t (nil)))) (sgml-ms-end-face ((t (:foreground "green")))) (sgml-ms-start-face ((t (:foreground "green")))) (sgml-pi-face ((t (:foreground "lime green")))) (sgml-sgml-face ((t (nil)))) (sgml-short-ref-face ((t (:foreground "deep sky blue")))) (sgml-start-tag-face ((t (nil)))) (shell-option-face ((t (:foreground "blue")))) (shell-output-2-face ((t (:foreground "darkseagreen")))) (shell-output-3-face ((t (:foreground "slategrey")))) (shell-output-face ((t (:foreground "palegreen")))) (shell-prompt-face ((t (:foreground "red")))) (show-paren-match-face ((t (:background "grey80")))) (show-paren-mismatch-face ((t (:bold t :background "purple" :foreground "white")))) (speedbar-button-face ((t (:bold t :foreground "green4")))) (speedbar-directory-face ((t (:bold t :foreground "blue4")))) (speedbar-file-face ((t (:bold t :foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:underline t :foreground "red")))) (speedbar-tag-face ((t (:foreground "brown")))) (swbuff-current-buffer-face ((t (:bold t)))) (template-message-face ((t (:bold t)))) (term-black ((t (:foreground "black")))) (term-blackbg ((t (:background "black")))) (term-blue ((t (:foreground "blue")))) (term-bluebg ((t (:background "blue")))) (term-bold ((t (:bold t)))) (term-cyan ((t (:foreground "cyan")))) (term-cyanbg ((t (:background "cyan")))) (term-default-bg ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-default-fg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-green ((t (:foreground "green")))) (term-greenbg ((t (:background "green")))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-magenta ((t (:foreground "magenta")))) (term-magentabg ((t (:background "magenta")))) (term-red ((t (:foreground "red")))) (term-redbg ((t (:background "red")))) (term-underline ((t (:underline t)))) (term-white ((t (:foreground "white")))) (term-whitebg ((t (:background "white")))) (term-yellow ((t (:foreground "yellow")))) (term-yellowbg ((t (:background "yellow")))) (text-cursor ((t (:background "grey15" :foreground "gainsboro")))) (toolbar ((t (nil)))) (underline ((t (:underline t)))) (vc-annotate-face-0046FF ((t (nil)))) (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) (vertical-divider ((t (nil)))) (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-search-face ((t (:background "khaki" :foreground "Black")))) (vvb-face ((t (:background "pink" :foreground "black")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "navy" :foreground "white")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "royalblue" :foreground "white")))) (woman-bold-face ((t (:bold t)))) (woman-italic-face ((t (nil)))) (woman-unknown-face ((t (nil)))) (xref-keyword-face ((t (:foreground "blue")))) (xref-list-pilot-face ((t (:foreground "navy")))) (xref-list-symbol-face ((t (:foreground "navy")))) (yellow ((t (nil)))) (zmacs-region ((t (:background "royalblue"))))))) (defun color-theme-oswald () "Color theme by Tom Oswald, created 2001-04-18. Green on black, includes font-lock, show-paren, and ediff." (interactive) (color-theme-install '(color-theme-oswald ((background-color . "black") (background-mode . dark) (border-color . "black") (cursor-color . "black") (foreground-color . "green") (mouse-color . "black")) ((blank-space-face . blank-space-face) (blank-tab-face . blank-tab-face) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (default ((t (nil)))) (blank-space-face ((t (:background "LightGray")))) (blank-tab-face ((t (:background "green" :foreground "black")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) (font-lock-builtin-face ((t (:italic t :bold t :foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:italic t :foreground "LightGoldenrod4")))) (font-lock-constant-face ((t (:italic t :foreground "HotPink")))) (font-lock-doc-string-face ((t (:italic t :foreground "orange")))) (font-lock-function-name-face ((t (:italic t :bold t :foreground "red")))) (font-lock-keyword-face ((t (:foreground "red")))) (font-lock-preprocessor-face ((t (:italic t :foreground "HotPink")))) (font-lock-string-face ((t (:italic t :foreground "orange")))) (font-lock-reference-face ((t (:italic t :bold t :foreground "LightSteelBlue")))) (font-lock-type-face ((t (:italic t :foreground "LightSlateBlue")))) (font-lock-variable-name-face ((t (:underline t :foreground "LightGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (highlight ((t (:background "yellow" :foreground "red")))) (isearch ((t (:background "dim gray" :foreground "aquamarine")))) (ispell-face ((t (:bold t :background "#3454b4" :foreground "yellow")))) (italic ((t (:italic t)))) (modeline ((t (:background "green" :foreground "black")))) (modeline-buffer-id ((t (:background "green" :foreground "black")))) (modeline-mousable ((t (:background "green" :foreground "black")))) (modeline-mousable-minor-mode ((t (:background "green" :foreground "black")))) (region ((t (:background "dim gray" :foreground "aquamarine")))) (secondary-selection ((t (:background "darkslateblue" :foreground "light goldenrod")))) (show-paren-match-face ((t (:background "turquoise" :foreground "black")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (underline ((t (:underline t)))) (zmacs-region ((t (:background "dim gray" :foreground "aquamarine"))))))) (defun color-theme-salmon-diff () "Salmon and aquamarine faces for diff and change-log modes. This is intended for other color themes to use (eg. `color-theme-gnome2')." (color-theme-install '(color-theme-salmon-diff nil (change-log-acknowledgement-face ((t (:foreground "LightBlue")))) (change-log-conditionals-face ((t (:bold t :weight bold :foreground "Aquamarine")))) (change-log-date-face ((t (:foreground "LightSalmon")))) (change-log-email-face ((t (:bold t :weight bold :foreground "Aquamarine")))) (change-log-file-face ((t (:bold t :weight bold :foreground "Aquamarine")))) (change-log-function-face ((t (:bold t :weight bold :foreground "Aquamarine")))) (change-log-list-face ((t (:foreground "Salmon")))) (change-log-name-face ((t (:foreground "Aquamarine")))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-context-face ((t (:foreground "grey70")))) (diff-file-header-face ((t (:bold t)))) (diff-function-face ((t (:foreground "grey70")))) (diff-header-face ((t (:foreground "light salmon")))) (diff-hunk-header-face ((t (:foreground "light salmon")))) (diff-index-face ((t (:bold t)))) (diff-nonexistent-face ((t (:bold t)))) (diff-removed-face ((t (nil)))) (log-view-message-face ((t (:foreground "light salmon"))))))) (defun color-theme-robin-hood () "`color-theme-gnome2' with navajo white on green. This theme tries to avoid underlined and italic faces, because the fonts either look ugly, or do not exist. The author himself uses neep, for example." (interactive) (color-theme-gnome2) (let ((color-theme-is-cumulative t)) (color-theme-install '(color-theme-robin-hood ((foreground-color . "navajo white") (background-color . "#304020")) ((CUA-mode-read-only-cursor-color . "white") (help-highlight-face . info-xref) (list-matching-lines-buffer-name-face . bold)) (default ((t (nil)))) (button ((t (:bold t)))) (calendar-today-face ((t (:foreground "lemon chiffon")))) (custom-button-face ((t (:bold t :foreground "DodgerBlue1")))) (diary-face ((t (:bold t :foreground "yellow")))) (fringe ((t (:background "#003700")))) (header-line ((t (:background "#030" :foreground "#AA7")))) (holiday-face ((t (:bold t :foreground "peru")))) (ido-subdir-face ((t (:foreground "MediumSlateBlue")))) (isearch ((t (:foreground "pink" :background "red")))) (isearch-lazy-highlight-face ((t (:foreground "red")))) (menu ((t (:background "#304020" :foreground "navajo white")))) (minibuffer-prompt ((t (:foreground "pale green")))) (modeline ((t (:background "dark olive green" :foreground "wheat" :box (:line-width 1 :style released-button))))) (mode-line-inactive ((t (:background "dark olive green" :foreground "khaki" :box (:line-width 1 :style released-button))))) (semantic-dirty-token-face ((t (:background "grey22")))) (tool-bar ((t (:background "#304020" :foreground "wheat" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "lemon chiffon" :foreground "black")))))))) (defun color-theme-snowish () "Color theme by Girish Bharadwaj, created 2001-05-17. Dark slate gray on snow2, lots of blue colors. Includes custom, eshell, font-lock, gnus, html-helper, hyper-apropos, jde, message, paren, semantic, speedbar, term, widget." (interactive) (color-theme-install '(color-theme-snowish ((background-color . "snow2") (background-mode . light) (cursor-color . "Red3") (foreground-color . "darkslategray")) ((buffers-tab-face . buffers-tab) (gnus-mouse-face . highlight) (sgml-set-face . t) (smiley-mouse-face . highlight)) (default ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t :foreground "peru")))) (bold-italic ((t (:italic t :bold t)))) (border-glyph ((t (nil)))) (buffers-tab ((t (:background "snow2" :foreground "darkslategray")))) (custom-button-face ((t (:bold t)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "gray85")))) (custom-comment-tag-face ((t (:foreground "blue4")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "blue")))) (cyan ((t (:foreground "cyan")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "red")))) (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) (eshell-ls-product-face ((t (:foreground "OrangeRed")))) (eshell-ls-readonly-face ((t (:foreground "Brown")))) (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan")))) (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) (eshell-prompt-face ((t (:bold t :foreground "Red")))) (font-lock-builtin-face ((t (:underline t :foreground "blue")))) (font-lock-comment-face ((t (:foreground "snow4")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-doc-string-face ((t (:foreground "mediumblue")))) (font-lock-function-name-face ((t (:bold t :foreground "darkblue")))) (font-lock-keyword-face ((t (:bold t :foreground "dodgerblue")))) (font-lock-preprocessor-face ((t (:underline t :foreground "blue3")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (:foreground "darkviolet")))) (font-lock-type-face ((t (:foreground "goldenrod")))) (font-lock-variable-name-face ((t (:foreground "tomato")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (gnus-cite-attribution-face ((t (nil)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (nil)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (nil)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t)))) (gnus-emphasis-underline-italic ((t (:underline t)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-header-content-face ((t (:foreground "indianred4")))) (gnus-header-from-face ((t (:foreground "red3")))) (gnus-header-name-face ((t (:foreground "maroon")))) (gnus-header-newsgroups-face ((t (:foreground "MidnightBlue")))) (gnus-header-subject-face ((t (:foreground "red4")))) (gnus-picons-face ((t (:background "white" :foreground "black")))) (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) (gnus-signature-face ((t (nil)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-low-unread-face ((t (nil)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (gnus-x-face ((t (:background "white" :foreground "black")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (:background "#D4D0C8" :foreground "black")))) (highlight ((t (:background "darkseagreen2")))) (html-helper-bold-face ((t (:bold t)))) (html-helper-bold-italic-face ((t (nil)))) (html-helper-builtin-face ((t (:underline t :foreground "blue3")))) (html-helper-italic-face ((t (:foreground "medium sea green")))) (html-helper-underline-face ((t (:underline t)))) (html-tag-face ((t (:bold t)))) (hyper-apropos-documentation ((t (:foreground "darkred")))) (hyper-apropos-heading ((t (:bold t)))) (hyper-apropos-hyperlink ((t (:foreground "blue4")))) (hyper-apropos-major-heading ((t (:bold t)))) (hyper-apropos-section-heading ((t (nil)))) (hyper-apropos-warning ((t (:bold t :foreground "red")))) (info-menu-6 ((t (nil)))) (isearch ((t (:background "paleturquoise")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (nil)))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) (jde-java-font-lock-link-face ((t (:underline t :foreground "blue")))) (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68" :foreground "darkslategray")))) (magenta ((t (:foreground "magenta")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (nil)))) (modeline-buffer-id ((t (:background "#D4D0C8" :foreground "blue4")))) (modeline-mousable ((t (:background "#D4D0C8" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:background "#D4D0C8" :foreground "green4")))) (paren-blink-off ((t (:foreground "snow2")))) (paren-match ((t (:background "darkseagreen2")))) (paren-mismatch ((t (:background "snow2" :foreground "darkslategray")))) (pointer ((t (nil)))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "paleturquoise")))) (semantic-intangible-face ((t (:foreground "gray25")))) (semantic-read-only-face ((t (:background "gray25")))) (senator-momentary-highlight-face ((t (:background "gray70")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:underline t :foreground "red")))) (speedbar-tag-face ((t (:foreground "brown")))) (template-message-face ((t (:bold t)))) (term-blue-bold-face ((t (:bold t :background "snow2" :foreground "blue")))) (term-blue-face ((t (:foreground "blue")))) (term-blue-inv-face ((t (:background "blue")))) (term-blue-ul-face ((t (:underline t :background "snow2" :foreground "blue")))) (term-cyan-bold-face ((t (:bold t :background "snow2" :foreground "cyan")))) (term-cyan-face ((t (:foreground "cyan")))) (term-cyan-inv-face ((t (:background "cyan")))) (term-cyan-ul-face ((t (:underline t :background "snow2" :foreground "cyan")))) (term-default-bold-face ((t (:bold t :background "snow2" :foreground "darkslategray")))) (term-default-face ((t (:background "snow2" :foreground "darkslategray")))) (term-default-inv-face ((t (:background "darkslategray" :foreground "snow2")))) (term-default-ul-face ((t (:underline t :background "snow2" :foreground "darkslategray")))) (term-green-bold-face ((t (:bold t :background "snow2" :foreground "green")))) (term-green-face ((t (:foreground "green")))) (term-green-inv-face ((t (:background "green")))) (term-green-ul-face ((t (:underline t :background "snow2" :foreground "green")))) (term-magenta-bold-face ((t (:bold t :background "snow2" :foreground "magenta")))) (term-magenta-face ((t (:foreground "magenta")))) (term-magenta-inv-face ((t (:background "magenta")))) (term-magenta-ul-face ((t (:underline t :background "snow2" :foreground "magenta")))) (term-red-bold-face ((t (:bold t :background "snow2" :foreground "red")))) (term-red-face ((t (:foreground "red")))) (term-red-inv-face ((t (:background "red")))) (term-red-ul-face ((t (:underline t :background "snow2" :foreground "red")))) (term-white-bold-face ((t (:bold t :background "snow2" :foreground "white")))) (term-white-face ((t (:foreground "white")))) (term-white-inv-face ((t (:background "snow2")))) (term-white-ul-face ((t (:underline t :background "snow2" :foreground "white")))) (term-yellow-bold-face ((t (:bold t :background "snow2" :foreground "yellow")))) (term-yellow-face ((t (:foreground "yellow")))) (term-yellow-inv-face ((t (:background "yellow")))) (term-yellow-ul-face ((t (:underline t :background "snow2" :foreground "yellow")))) (text-cursor ((t (:background "Red3" :foreground "snow2")))) (toolbar ((t (nil)))) (underline ((t (:underline t)))) (vertical-divider ((t (nil)))) (white ((t (:foreground "white")))) (widget ((t (nil)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "gray65"))))))) (defun color-theme-dark-laptop () "Color theme by Laurent Michel, created 2001-05-24. Includes custom, fl, font-lock, gnus, message, widget." (interactive) (color-theme-install '(color-theme-dark-laptop ((background-color . "black") (background-mode . dark) (border-color . "black") (cursor-color . "yellow") (foreground-color . "white") (mouse-color . "sienna1")) ((gnus-mouse-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (default ((t (nil)))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (custom-button-face ((t (nil)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "light blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "lime green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "light blue")))) (fl-comment-face ((t (:foreground "pink")))) (fl-doc-string-face ((t (:foreground "purple")))) (fl-function-name-face ((t (:foreground "red")))) (fl-keyword-face ((t (:foreground "cyan")))) (fl-string-face ((t (:foreground "green")))) (fl-type-face ((t (:foreground "yellow")))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:foreground "OrangeRed")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) (font-lock-keyword-face ((t (:foreground "Cyan")))) (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) (font-lock-reference-face ((t (:foreground "LightSteelBlue")))) (font-lock-string-face ((t (:foreground "LightSalmon")))) (font-lock-type-face ((t (:foreground "PaleGreen")))) (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (gnus-cite-attribution-face ((t (:italic t)))) (gnus-cite-face-1 ((t (:bold t :foreground "deep sky blue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:bold t :foreground "cyan")))) (gnus-cite-face-3 ((t (:bold t :foreground "gold")))) (gnus-cite-face-4 ((t (:foreground "light pink")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:bold t :foreground "chocolate")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) (gnus-header-content-face ((t (:italic t :foreground "forest green")))) (gnus-header-from-face ((t (:bold t :foreground "spring green")))) (gnus-header-name-face ((t (:foreground "deep sky blue")))) (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "purple")))) (gnus-header-subject-face ((t (:bold t :foreground "orange")))) (gnus-signature-face ((t (:bold t :foreground "khaki")))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (highlight ((t (:background "darkolivegreen")))) (italic ((t (:italic t)))) (message-cited-text-face ((t (:bold t :foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "green4")))) (message-header-name-face ((t (:bold t :foreground "orange")))) (message-header-newsgroups-face ((t (:bold t :foreground "violet")))) (message-header-other-face ((t (:bold t :foreground "chocolate")))) (message-header-subject-face ((t (:bold t :foreground "yellow")))) (message-header-to-face ((t (:bold t :foreground "cyan")))) (message-header-xheader-face ((t (:bold t :foreground "light blue")))) (message-mml-face ((t (:bold t :background "Green3")))) (message-separator-face ((t (:foreground "blue3")))) (modeline ((t (:background "white" :foreground "black")))) (modeline-buffer-id ((t (:background "white" :foreground "black")))) (modeline-mousable ((t (:background "white" :foreground "black")))) (modeline-mousable-minor-mode ((t (:background "white" :foreground "black")))) (region ((t (:background "blue")))) (primary-selection ((t (:background "blue")))) (isearch ((t (:background "blue")))) (zmacs-region ((t (:background "blue")))) (secondary-selection ((t (:background "darkslateblue")))) (underline ((t (:underline t)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray"))))))) (defun color-theme-taming-mr-arneson () "Color theme by Erik Arneson, created 2001-06-12. Light sky blue on black. Includes bbdb, cperl, custom, cvs, diff, dired, font-lock, html-helper, hyper-apropos, info, isearch, man, message, paren, shell, and widget." (interactive) (color-theme-install '(color-theme-taming-mr-arneson ((background-color . "black") (background-mode . light) (background-toolbar-color . "#cf3ccf3ccf3c") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#79e77df779e7") (cursor-color . "Red3") (foreground-color . "LightSkyBlue") (top-toolbar-shadow-color . "#fffffbeeffff")) ((buffers-tab-face . buffers-tab) (cperl-here-face . font-lock-string-face) (cperl-invalid-face quote default) (cperl-pod-face . font-lock-comment-face) (cperl-pod-head-face . font-lock-variable-name-face) (ispell-highlight-face . highlight) (vc-mode-face . highlight) (vm-highlight-url-face . bold-italic) (vm-highlighted-header-face . bold) (vm-mime-button-face . gui-button-face) (vm-summary-highlight-face . bold)) (default ((t (nil)))) (bbdb-company ((t (nil)))) (bbdb-field-name ((t (:bold t)))) (bbdb-field-value ((t (nil)))) (bbdb-name ((t (:underline t)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:bold t :foreground "yellow")))) (border-glyph ((t (nil)))) (buffers-tab ((t (:background "black" :foreground "LightSkyBlue")))) (cperl-array-face ((t (:bold t :foreground "SkyBlue2")))) (cperl-hash-face ((t (:foreground "LightBlue2")))) (cperl-invalid-face ((t (:foreground "white")))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (custom-button-face ((t (:bold t)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:foreground "white")))) (custom-comment-tag-face ((t (:foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "white")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "blue")))) (cvs-filename-face ((t (:foreground "white")))) (cvs-handled-face ((t (:foreground "pink")))) (cvs-header-face ((t (:foreground "green")))) (cvs-marked-face ((t (:bold t :foreground "green3")))) (cvs-msg-face ((t (:foreground "red")))) (cvs-need-action-face ((t (:foreground "yellow")))) (cvs-unknown-face ((t (:foreground "grey")))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-file-header-face ((t (:bold t :background "grey70")))) (diff-hunk-header-face ((t (:background "grey85")))) (diff-index-face ((t (:bold t :background "grey70")))) (diff-removed-face ((t (nil)))) (dired-face-boring ((t (:foreground "Gray65")))) (dired-face-directory ((t (:bold t :foreground "SkyBlue2")))) (dired-face-executable ((t (:foreground "Green")))) (dired-face-flagged ((t (:background "LightSlateGray")))) (dired-face-header ((t (:background "grey75" :foreground "black")))) (dired-face-marked ((t (:background "PaleVioletRed")))) (dired-face-permissions ((t (:background "grey75" :foreground "black")))) (dired-face-setuid ((t (:foreground "Red")))) (dired-face-socket ((t (:foreground "magenta")))) (dired-face-symlink ((t (:foreground "cyan")))) (excerpt ((t (nil)))) (fixed ((t (:bold t)))) (font-lock-builtin-face ((t (:foreground "red3")))) (font-lock-comment-face ((t (:foreground "red")))) (font-lock-constant-face ((t (nil)))) (font-lock-doc-string-face ((t (:foreground "turquoise")))) (font-lock-function-name-face ((t (:foreground "white")))) (font-lock-keyword-face ((t (:foreground "green")))) (font-lock-preprocessor-face ((t (:foreground "green3")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (:foreground "turquoise")))) (font-lock-type-face ((t (:foreground "steelblue")))) (font-lock-variable-name-face ((t (:foreground "magenta2")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (nil)))) (highlight ((t (:background "darkseagreen2" :foreground "blue")))) (html-helper-bold-face ((t (:bold t)))) (html-helper-italic-face ((t (:bold t :foreground "yellow")))) (html-helper-underline-face ((t (:underline t)))) (hyper-apropos-documentation ((t (:foreground "white")))) (hyper-apropos-heading ((t (:bold t)))) (hyper-apropos-hyperlink ((t (:foreground "sky blue")))) (hyper-apropos-major-heading ((t (:bold t)))) (hyper-apropos-section-heading ((t (:bold t)))) (hyper-apropos-warning ((t (:bold t :foreground "red")))) (info-node ((t (:bold t :foreground "yellow")))) (info-xref ((t (:bold t)))) (isearch ((t (:background "paleturquoise" :foreground "dark red")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (:bold t :foreground "yellow")))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68" :foreground "dark green")))) (man-bold ((t (:bold t)))) (man-heading ((t (:bold t)))) (man-italic ((t (:foreground "yellow")))) (man-xref ((t (:underline t)))) (message-cited-text ((t (:foreground "orange")))) (message-header-contents ((t (:foreground "white")))) (message-headers ((t (:bold t :foreground "orange")))) (message-highlighted-header-contents ((t (:bold t)))) (message-url ((t (:bold t :foreground "pink")))) (mmm-face ((t (:background "black" :foreground "green")))) (modeline ((t (nil)))) (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) (paren-blink-off ((t (:foreground "gray80")))) (paren-match ((t (:background "dark blue")))) (paren-mismatch ((t (:background "DeepPink" :foreground "LightSkyBlue")))) (pointer ((t (nil)))) (primary-selection ((t (:background "gray65" :foreground "DarkBlue")))) (red ((t (:foreground "red")))) (region ((t (:background "gray65" :foreground "DarkBlue")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "paleturquoise" :foreground "black")))) (shell-option-face ((t (:foreground "blue4")))) (shell-output-2-face ((t (:foreground "green4")))) (shell-output-3-face ((t (:foreground "green4")))) (shell-output-face ((t (:bold t)))) (shell-prompt-face ((t (:foreground "red4")))) (text-cursor ((t (:background "Red3" :foreground "black")))) (toolbar ((t (:background "Gray80" :foreground "black")))) (underline ((t (:underline t)))) (vertical-divider ((t (nil)))) (vm-xface ((t (:background "white" :foreground "black")))) (vmpc-pre-sig-face ((t (:foreground "forestgreen")))) (vmpc-sig-face ((t (:foreground "steelblue")))) (widget ((t (nil)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85" :foreground "black")))) (widget-inactive-face ((t (:foreground "dim gray")))) (x-face ((t (:background "white" :foreground "black")))) (xrdb-option-name-face ((t (:foreground "red")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "gray65"))))))) (defun color-theme-digital-ofs1 () "Color theme by Gareth Owen, created 2001-06-13. This works well on an old, beat-up Digital Unix box with its 256 colour display, on which other color themes hog too much of the palette. Black on some shade of dark peach. Includes bbdb, cperl, custom, cvs, diff, dired, ediff, erc, eshell, font-latex, font-lock, gnus, highlight, hproperty, html-helper, hyper-apropos, info, jde, man, message, paren, searchm, semantic, sgml, shell, speedbar, term, vhdl, viper, w3m, widget, woman, x-symbol, xref." (interactive) (color-theme-install '(color-theme-digital-ofs1 ((background-color . "#CA94AA469193") (background-mode . light) (background-toolbar-color . "#cf3ccf3ccf3c") (border-color . "black") (bottom-toolbar-shadow-color . "#79e77df779e7") (cursor-color . "Black") (foreground-color . "Black") (mouse-color . "Black") (top-toolbar-shadow-color . "#fffffbeeffff") (viper-saved-cursor-color-in-replace-mode . "Red3")) ((Man-overstrike-face . bold) (Man-underline-face . underline) (gnus-mouse-face . highlight) (goto-address-mail-face . italic) (goto-address-mail-mouse-face . secondary-selection) (goto-address-url-face . bold) (goto-address-url-mouse-face . highlight) (ispell-highlight-face . highlight) (list-matching-lines-face . bold) (rmail-highlight-face . font-lock-function-name-face) (view-highlight-face . highlight)) (default ((t (:bold t)))) (bbdb-company ((t (:italic t)))) (bbdb-field-name ((t (:bold t)))) (bbdb-field-value ((t (nil)))) (bbdb-name ((t (:underline t)))) (blank-space-face ((t (nil)))) (blank-tab-face ((t (nil)))) (blue ((t (:bold t :foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (border-glyph ((t (:bold t)))) (buffers-tab ((t (:background "black" :foreground "LightSkyBlue")))) (calendar-today-face ((t (:underline t :bold t :foreground "white")))) (comint-input-face ((t (nil)))) (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) (cperl-here-face ((t (nil)))) (cperl-invalid-face ((t (:foreground "white")))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (cperl-pod-face ((t (nil)))) (cperl-pod-head-face ((t (nil)))) (custom-button-face ((t (:bold t)))) (custom-changed-face ((t (:bold t :background "blue" :foreground "white")))) (custom-comment-face ((t (:foreground "white")))) (custom-comment-tag-face ((t (:foreground "white")))) (custom-documentation-face ((t (:bold t)))) (custom-face-tag-face ((t (:underline t :bold t)))) (custom-group-tag-face ((t (:underline t :bold t :foreground "DarkBlue")))) (custom-group-tag-face-1 ((t (:underline t :bold t :foreground "red")))) (custom-invalid-face ((t (:bold t :background "red" :foreground "yellow")))) (custom-modified-face ((t (:bold t :background "blue" :foreground "white")))) (custom-rogue-face ((t (:bold t :background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t :bold t)))) (custom-set-face ((t (:bold t :background "white" :foreground "blue")))) (custom-state-face ((t (:bold t :foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :bold t :foreground "blue")))) (cvs-filename-face ((t (:foreground "white")))) (cvs-handled-face ((t (:foreground "pink")))) (cvs-header-face ((t (:bold t :foreground "green")))) (cvs-marked-face ((t (:bold t :foreground "green3")))) (cvs-msg-face ((t (:italic t :foreground "red")))) (cvs-need-action-face ((t (:foreground "yellow")))) (cvs-unknown-face ((t (:foreground "grey")))) (cyan ((t (:foreground "cyan")))) (diary-face ((t (:bold t :foreground "red")))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-file-header-face ((t (:bold t :background "grey70")))) (diff-hunk-header-face ((t (:background "grey85")))) (diff-index-face ((t (:bold t :background "grey70")))) (diff-removed-face ((t (nil)))) (dired-face-boring ((t (:foreground "Gray65")))) (dired-face-directory ((t (:bold t)))) (dired-face-executable ((t (:foreground "SeaGreen")))) (dired-face-flagged ((t (:background "LightSlateGray")))) (dired-face-header ((t (:background "grey75" :foreground "black")))) (dired-face-marked ((t (:background "PaleVioletRed")))) (dired-face-permissions ((t (:background "grey75" :foreground "black")))) (dired-face-setuid ((t (:foreground "Red")))) (dired-face-socket ((t (:foreground "magenta")))) (dired-face-symlink ((t (:foreground "cyan")))) (display-time-mail-balloon-enhance-face ((t (:bold t :background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:bold t :foreground "blue")))) (display-time-time-balloon-face ((t (:bold t :foreground "red")))) (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) (erc-action-face ((t (:bold t)))) (erc-bold-face ((t (:bold t)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (nil)))) (erc-error-face ((t (:bold t)))) (erc-input-face ((t (nil)))) (erc-inverse-face ((t (nil)))) (erc-notice-face ((t (nil)))) (erc-pal-face ((t (nil)))) (erc-prompt-face ((t (nil)))) (erc-underline-face ((t (nil)))) (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) (eshell-ls-picture-face ((t (:foreground "Violet")))) (eshell-ls-product-face ((t (:foreground "OrangeRed")))) (eshell-ls-readonly-face ((t (:foreground "Brown")))) (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) (eshell-ls-text-face ((t (:foreground "medium aquamarine")))) (eshell-ls-todo-face ((t (:bold t :foreground "aquamarine")))) (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) (eshell-prompt-face ((t (:bold t :foreground "Red")))) (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) (eshell-test-ok-face ((t (:bold t :foreground "Green")))) (excerpt ((t (:italic t)))) (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) (fg:black ((t (:foreground "black")))) (fixed ((t (:bold t)))) (fl-comment-face ((t (:foreground "medium purple")))) (fl-doc-string-face ((t (nil)))) (fl-function-name-face ((t (:foreground "green")))) (fl-keyword-face ((t (:foreground "LightGreen")))) (fl-string-face ((t (:foreground "light coral")))) (fl-type-face ((t (:foreground "cyan")))) (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) (font-latex-bold-face ((t (:bold t)))) (font-latex-italic-face ((t (:italic t)))) (font-latex-math-face ((t (nil)))) (font-latex-sedate-face ((t (nil)))) (font-latex-string-face ((t (nil)))) (font-latex-warning-face ((t (nil)))) (font-lock-builtin-face ((t (:italic t :bold t :foreground "Orchid")))) (font-lock-comment-face ((t (:bold t :foreground "Firebrick")))) (font-lock-constant-face ((t (:italic t :bold t :foreground "CadetBlue")))) (font-lock-doc-string-face ((t (:italic t :bold t :foreground "green4")))) (font-lock-emphasized-face ((t (:bold t)))) (font-lock-exit-face ((t (:foreground "green")))) (font-lock-function-name-face ((t (:italic t :bold t :foreground "Blue")))) (font-lock-keyword-face ((t (:bold t :foreground "dark olive green")))) (font-lock-other-emphasized-face ((t (:italic t :bold t)))) (font-lock-other-type-face ((t (:bold t :foreground "DarkBlue")))) (font-lock-preprocessor-face ((t (:italic t :bold t :foreground "blue3")))) (font-lock-reference-face ((t (:italic t :bold t :foreground "red3")))) (font-lock-special-comment-face ((t (nil)))) (font-lock-special-keyword-face ((t (nil)))) (font-lock-string-face ((t (:italic t :bold t :foreground "DarkBlue")))) (font-lock-type-face ((t (:italic t :bold t :foreground "DarkGreen")))) (font-lock-variable-name-face ((t (:italic t :bold t :foreground "darkgreen")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (fringe ((t (:background "grey95")))) (gdb-arrow-face ((t (:bold t)))) (gnus-cite-attribution-face ((t (:italic t :bold t)))) (gnus-cite-face-1 ((t (:bold t :foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:bold t :foreground "firebrick")))) (gnus-cite-face-3 ((t (:bold t :foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:bold t :foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-cite-face-list ((t (nil)))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) (gnus-filterhist-face-1 ((t (nil)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) (gnus-header-from-face ((t (:bold t :foreground "red3")))) (gnus-header-name-face ((t (:bold t :foreground "maroon")))) (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MidnightBlue")))) (gnus-header-subject-face ((t (:bold t :foreground "red4")))) (gnus-picons-face ((t (:background "white" :foreground "black")))) (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) (gnus-signature-face ((t (:italic t :bold t)))) (gnus-splash ((t (nil)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-high-unread-face ((t (:italic t :bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "firebrick")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (:bold t)))) (gnus-summary-selected-face ((t (:underline t)))) (gnus-x-face ((t (:background "white" :foreground "black")))) (green ((t (:bold t :foreground "green")))) (gui-button-face ((t (:bold t :background "grey75" :foreground "black")))) (gui-element ((t (:bold t :background "Gray80")))) (highlight ((t (:bold t :background "darkseagreen2")))) (highlight-changes-delete-face ((t (:underline t :foreground "red")))) (highlight-changes-face ((t (:foreground "red")))) (highline-face ((t (:background "black" :foreground "white")))) (holiday-face ((t (:bold t :background "pink" :foreground "white")))) (hproperty:but-face ((t (:bold t)))) (hproperty:flash-face ((t (:bold t)))) (hproperty:highlight-face ((t (:bold t)))) (hproperty:item-face ((t (:bold t)))) (html-helper-bold-face ((t (:bold t)))) (html-helper-bold-italic-face ((t (nil)))) (html-helper-builtin-face ((t (:underline t :foreground "blue3")))) (html-helper-italic-face ((t (:italic t :bold t :foreground "yellow")))) (html-helper-underline-face ((t (:underline t)))) (html-tag-face ((t (:bold t)))) (hyper-apropos-documentation ((t (:foreground "white")))) (hyper-apropos-heading ((t (:bold t)))) (hyper-apropos-hyperlink ((t (:foreground "sky blue")))) (hyper-apropos-major-heading ((t (:bold t)))) (hyper-apropos-section-heading ((t (:bold t)))) (hyper-apropos-warning ((t (:bold t :foreground "red")))) (ibuffer-marked-face ((t (:foreground "red")))) (info-menu-5 ((t (:underline t :bold t)))) (info-menu-6 ((t (nil)))) (info-node ((t (:italic t :bold t)))) (info-xref ((t (:bold t)))) (isearch ((t (:bold t :background "paleturquoise")))) (isearch-secondary ((t (:foreground "red3")))) (ispell-face ((t (:bold t)))) (italic ((t (:italic t :bold t)))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) (jde-java-font-lock-link-face ((t (:underline t :foreground "blue")))) (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) (left-margin ((t (:bold t)))) (linemenu-face ((t (nil)))) (list-mode-item-selected ((t (:bold t :background "gray68")))) (magenta ((t (:foreground "magenta")))) (makefile-space-face ((t (:background "hotpink")))) (man-bold ((t (:bold t)))) (man-heading ((t (:bold t)))) (man-italic ((t (:foreground "yellow")))) (man-xref ((t (:underline t)))) (message-cited-text ((t (:bold t :foreground "orange")))) (message-cited-text-face ((t (:bold t :foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-contents ((t (:italic t :bold t :foreground "white")))) (message-header-name-face ((t (:bold t :foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) (message-header-other-face ((t (:bold t :foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:bold t :foreground "blue")))) (message-headers ((t (:bold t :foreground "orange")))) (message-highlighted-header-contents ((t (:bold t)))) (message-mml-face ((t (:bold t :foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (message-url ((t (:bold t :foreground "pink")))) (mmm-face ((t (:background "black" :foreground "green")))) (modeline ((t (:bold t :background "Black" :foreground "#CA94AA469193")))) (modeline-buffer-id ((t (:bold t :background "Gray80" :foreground "blue4")))) (modeline-mousable ((t (:bold t :background "Gray80" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:bold t :background "Gray80" :foreground "green4")))) (my-tab-face ((t (nil)))) (nil ((t (nil)))) (p4-diff-del-face ((t (:bold t)))) (paren-blink-off ((t (:foreground "gray80")))) (paren-face ((t (nil)))) (paren-face-match ((t (nil)))) (paren-face-mismatch ((t (nil)))) (paren-face-no-match ((t (nil)))) (paren-match ((t (:background "darkseagreen2")))) (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) (paren-mismatch-face ((t (:bold t :background "DeepPink" :foreground "white")))) (paren-no-match-face ((t (:bold t :background "yellow" :foreground "white")))) (pointer ((t (:bold t)))) (primary-selection ((t (:bold t :background "gray65")))) (red ((t (:bold t :foreground "red")))) (region ((t (:bold t :background "gray")))) (right-margin ((t (:bold t)))) (searchm-buffer ((t (:bold t)))) (searchm-button ((t (:bold t)))) (searchm-field ((t (nil)))) (searchm-field-label ((t (:bold t)))) (searchm-highlight ((t (:bold t)))) (secondary-selection ((t (:bold t :background "paleturquoise")))) (semantic-intangible-face ((t (:foreground "gray25")))) (semantic-read-only-face ((t (:background "gray25")))) (senator-momentary-highlight-face ((t (:background "gray70")))) (setnu-line-number-face ((t (:italic t :bold t)))) (sgml-comment-face ((t (:foreground "dark green")))) (sgml-doctype-face ((t (:foreground "maroon")))) (sgml-end-tag-face ((t (:foreground "blue2")))) (sgml-entity-face ((t (:foreground "red2")))) (sgml-ignored-face ((t (:background "gray90" :foreground "maroon")))) (sgml-ms-end-face ((t (:foreground "maroon")))) (sgml-ms-start-face ((t (:foreground "maroon")))) (sgml-pi-face ((t (:foreground "maroon")))) (sgml-sgml-face ((t (:foreground "maroon")))) (sgml-short-ref-face ((t (:foreground "goldenrod")))) (sgml-start-tag-face ((t (:foreground "blue2")))) (shell-input-face ((t (:bold t)))) (shell-option-face ((t (:bold t :foreground "blue4")))) (shell-output-2-face ((t (:bold t :foreground "green4")))) (shell-output-3-face ((t (:bold t :foreground "green4")))) (shell-output-face ((t (:bold t)))) (shell-prompt-face ((t (:bold t :foreground "red4")))) (show-paren-match-face ((t (:bold t :background "turquoise")))) (show-paren-mismatch-face ((t (:bold t :background "purple" :foreground "white")))) (speedbar-button-face ((t (:bold t :foreground "magenta")))) (speedbar-directory-face ((t (:bold t :foreground "orchid")))) (speedbar-file-face ((t (:bold t :foreground "pink")))) (speedbar-highlight-face ((t (:background "black")))) (speedbar-selected-face ((t (:underline t :foreground "cyan")))) (speedbar-tag-face ((t (:foreground "yellow")))) (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) (template-message-face ((t (:bold t)))) (term-black ((t (:foreground "black")))) (term-blackbg ((t (:background "black")))) (term-blue ((t (:foreground "blue")))) (term-blue-bold-face ((t (:bold t :background "snow2" :foreground "blue")))) (term-blue-face ((t (:foreground "blue")))) (term-blue-inv-face ((t (:background "blue")))) (term-blue-ul-face ((t (:underline t :background "snow2" :foreground "blue")))) (term-bluebg ((t (:background "blue")))) (term-bold ((t (:bold t)))) (term-cyan ((t (:foreground "cyan")))) (term-cyan-bold-face ((t (:bold t :background "snow2" :foreground "cyan")))) (term-cyan-face ((t (:foreground "cyan")))) (term-cyan-inv-face ((t (:background "cyan")))) (term-cyan-ul-face ((t (:underline t :background "snow2" :foreground "cyan")))) (term-cyanbg ((t (:background "cyan")))) (term-default-bg ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-default-bold-face ((t (:bold t :background "snow2" :foreground "darkslategray")))) (term-default-face ((t (:background "snow2" :foreground "darkslategray")))) (term-default-fg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-default-inv-face ((t (:background "darkslategray" :foreground "snow2")))) (term-default-ul-face ((t (:underline t :background "snow2" :foreground "darkslategray")))) (term-green ((t (:foreground "green")))) (term-green-bold-face ((t (:bold t :background "snow2" :foreground "green")))) (term-green-face ((t (:foreground "green")))) (term-green-inv-face ((t (:background "green")))) (term-green-ul-face ((t (:underline t :background "snow2" :foreground "green")))) (term-greenbg ((t (:background "green")))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-magenta ((t (:foreground "magenta")))) (term-magenta-bold-face ((t (:bold t :background "snow2" :foreground "magenta")))) (term-magenta-face ((t (:foreground "magenta")))) (term-magenta-inv-face ((t (:background "magenta")))) (term-magenta-ul-face ((t (:underline t :background "snow2" :foreground "magenta")))) (term-magentabg ((t (:background "magenta")))) (term-red ((t (:foreground "red")))) (term-red-bold-face ((t (:bold t :background "snow2" :foreground "red")))) (term-red-face ((t (:foreground "red")))) (term-red-inv-face ((t (:background "red")))) (term-red-ul-face ((t (:underline t :background "snow2" :foreground "red")))) (term-redbg ((t (:background "red")))) (term-underline ((t (:underline t)))) (term-white ((t (:foreground "white")))) (term-white-bold-face ((t (:bold t :background "snow2" :foreground "white")))) (term-white-face ((t (:foreground "white")))) (term-white-inv-face ((t (:background "snow2")))) (term-white-ul-face ((t (:underline t :background "snow2" :foreground "white")))) (term-whitebg ((t (:background "white")))) (term-yellow ((t (:foreground "yellow")))) (term-yellow-bold-face ((t (:bold t :background "snow2" :foreground "yellow")))) (term-yellow-face ((t (:foreground "yellow")))) (term-yellow-inv-face ((t (:background "yellow")))) (term-yellow-ul-face ((t (:underline t :background "snow2" :foreground "yellow")))) (term-yellowbg ((t (:background "yellow")))) (text-cursor ((t (:bold t :background "Red3" :foreground "gray80")))) (toolbar ((t (:bold t :background "Gray80")))) (underline ((t (:underline t :bold t)))) (vc-annotate-face-0046FF ((t (nil)))) (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) (vertical-divider ((t (:bold t :background "Gray80")))) (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) (vhdl-font-lock-generic-/constant-face ((t (nil)))) (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-font-lock-type-face ((t (nil)))) (vhdl-font-lock-variable-face ((t (nil)))) (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) (vhdl-speedbar-subprogram-face ((t (nil)))) (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-search-face ((t (:background "khaki" :foreground "Black")))) (vm-xface ((t (:background "white" :foreground "black")))) (vmpc-pre-sig-face ((t (:foreground "forestgreen")))) (vmpc-sig-face ((t (:foreground "steelblue")))) (vvb-face ((t (nil)))) (w3m-anchor-face ((t (:bold t :foreground "DodgerBlue1")))) (w3m-arrived-anchor-face ((t (:bold t :foreground "DodgerBlue3")))) (w3m-header-line-location-content-face ((t (:background "dark olive green" :foreground "wheat")))) (w3m-header-line-location-title-face ((t (:background "dark olive green" :foreground "beige")))) (white ((t (:foreground "white")))) (widget ((t (nil)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:bold t :foreground "red")))) (widget-documentation-face ((t (:bold t :foreground "dark green")))) (widget-field-face ((t (:bold t :background "gray85")))) (widget-inactive-face ((t (:bold t :foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85")))) (woman-bold-face ((t (:bold t)))) (woman-italic-face ((t (:foreground "beige")))) (woman-unknown-face ((t (:foreground "LightSalmon")))) (x-face ((t (:bold t :background "white" :foreground "black")))) (x-symbol-adobe-fontspecific-face ((t (nil)))) (x-symbol-face ((t (nil)))) (x-symbol-heading-face ((t (:bold t)))) (x-symbol-info-face ((t (nil)))) (x-symbol-invisible-face ((t (nil)))) (x-symbol-revealed-face ((t (nil)))) (xrdb-option-name-face ((t (:foreground "red")))) (xref-keyword-face ((t (:foreground "blue")))) (xref-list-default-face ((t (nil)))) (xref-list-pilot-face ((t (:foreground "navy")))) (xref-list-symbol-face ((t (:foreground "navy")))) (yellow ((t (:bold t :foreground "yellow")))) (zmacs-region ((t (:bold t :background "gray65"))))))) (defun color-theme-mistyday () "Color theme by K.C. Hari Kumar, created 2001-06-13. Black on mistyrose. Includes CUA, calendar, diary, font-latex and font-lock. Uses backgrounds on some font-lock faces." (interactive) (color-theme-install '(color-theme-mistyday ((background-color . "mistyrose") (background-mode . light) (border-color . "black") (cursor-color . "deep pink") (foreground-color . "Black") (mouse-color . "black")) ((goto-address-mail-face . italic) (goto-address-mail-mouse-face . secondary-selection) (goto-address-url-face . bold) (goto-address-url-mouse-face . highlight) (list-matching-lines-face . bold) (paren-match-face . paren-face-match) (paren-mismatch-face . paren-face-mismatch) (paren-no-match-face . paren-face-no-match)) (default ((t (nil)))) (CUA-global-mark-face ((t (:background "cyan" :foreground "black")))) (CUA-rectangle-face ((t (:background "maroon" :foreground "white")))) (CUA-rectangle-noselect-face ((t (:background "dimgray" :foreground "white")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (calendar-today-face ((t (:underline t :background "Spring Green" :foreground "Brown")))) (custom-button-face ((t (:background "dark slate grey" :foreground "azure")))) (custom-documentation-face ((t (:background "white" :foreground "blue")))) (diary-face ((t (:background "navy" :foreground "yellow")))) (font-latex-bold-face ((t (:bold t :foreground "DarkOliveGreen")))) (font-latex-italic-face ((t (:italic t :foreground "DarkOliveGreen")))) (font-latex-math-face ((t (:foreground "navy")))) (font-latex-sedate-face ((t (:foreground "DimGray")))) (font-latex-string-face ((t (nil)))) (font-latex-warning-face ((t (nil)))) (font-lock-builtin-face ((t (:background "DarkTurquoise" :foreground "Navy")))) (font-lock-comment-face ((t (:italic t :foreground "royal blue")))) (font-lock-constant-face ((t (:background "pale green" :foreground "dark slate blue")))) (font-lock-doc-string-face ((t (:background "medium aquamarine" :foreground "deep pink")))) (font-lock-function-name-face ((t (:background "SpringGreen" :foreground "MidnightBlue")))) (font-lock-keyword-face ((t (:foreground "dark magenta")))) (font-lock-preprocessor-face ((t (:background "pale green" :foreground "dark slate blue")))) (font-lock-reference-face ((t (:background "DarkTurquoise" :foreground "Navy")))) (font-lock-string-face ((t (:background "medium aquamarine" :foreground "deep pink")))) (font-lock-type-face ((t (:background "steel blue" :foreground "khaki")))) (font-lock-variable-name-face ((t (:background "thistle" :foreground "orange red")))) (font-lock-warning-face ((t (:background "LemonChiffon" :foreground "Red")))) (highlight ((t (:background "dark slate grey" :foreground "light cyan")))) (holiday-face ((t (:background "orangered" :foreground "lightyellow")))) (ido-first-match-face ((t (:bold t)))) (ido-only-match-face ((t (:foreground "ForestGreen")))) (ido-subdir-face ((t (:foreground "red")))) (italic ((t (:italic t)))) (isearch ((t (:background "sienna" :foreground "light cyan")))) (modeline ((t (:background "Royalblue4" :foreground "lawn green")))) (modeline-buffer-id ((t (:background "Royalblue4" :foreground "lawn green")))) (modeline-mousable ((t (:background "Royalblue4" :foreground "lawn green")))) (modeline-mousable-minor-mode ((t (:background "Royalblue4" :foreground "lawn green")))) (paren-face-match ((t (:background "turquoise")))) (paren-face-mismatch ((t (:background "purple" :foreground "white")))) (paren-face-no-match ((t (:background "yellow" :foreground "black")))) (primary-selection ((t (:background "sienna" :foreground "light cyan")))) (region ((t (:background "sienna" :foreground "light cyan")))) (secondary-selection ((t (:background "forest green" :foreground "white smoke")))) (underline ((t (:underline t)))) (zmacs-region ((t (:background "sienna" :foreground "light cyan"))))))) (defun color-theme-marine () "Color theme by Girish Bharadwaj, created 2001-06-22. Matches the MS Windows Marine color theme. Includes custom, font-lock, paren, widget." (interactive) (color-theme-install '(color-theme-marine ((background-color . "#9dcec9") (background-mode . light) (border-color . "black") (cursor-color . "yellow") (foreground-color . "darkslategray") (mouse-color . "sienna1")) ((buffers-tab-face . buffers-tab) (gnus-mouse-face . highlight) (smiley-mouse-face . highlight)) (default ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (nil)))) (border-glyph ((t (nil)))) (buffers-tab ((t (:background "#9dcec9" :foreground "darkslategray")))) (custom-button-face ((t (nil)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "gray85")))) (custom-comment-tag-face ((t (:foreground "blue4")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "deeppink")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "darkgreen")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "blue")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "red")))) (font-lock-builtin-face ((t (:foreground "SteelBlue")))) (font-lock-comment-face ((t (:foreground "cadetblue")))) (font-lock-constant-face ((t (:foreground "OrangeRed")))) (font-lock-doc-string-face ((t (:foreground "Salmon")))) (font-lock-function-name-face ((t (:bold t :foreground "NavyBlue")))) (font-lock-keyword-face ((t (:bold t :foreground "purple")))) (font-lock-preprocessor-face ((t (:foreground "SteelBlue")))) (font-lock-reference-face ((t (:foreground "SteelBlue")))) (font-lock-string-face ((t (:foreground "royalblue")))) (font-lock-type-face ((t (:foreground "darkmagenta")))) (font-lock-variable-name-face ((t (:foreground "violetred")))) (font-lock-warning-face ((t (:bold t :foreground "red")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (:background "#489088" :foreground "black")))) (highlight ((t (:background "darkolivegreen" :foreground "white")))) (isearch ((t (:background "blue")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (nil)))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68" :foreground "darkslategray")))) (modeline ((t (:background "black" :foreground "white")))) (modeline-buffer-id ((t (:background "black" :foreground "white")))) (modeline-mousable ((t (:background "black" :foreground "white")))) (modeline-mousable-minor-mode ((t (:background "black" :foreground "white")))) (paren-blink-off ((t (:foreground "black")))) (paren-match ((t (:background "darkolivegreen" :foreground "white")))) (paren-mismatch ((t (:background "#9dcec9" :foreground "darkslategray")))) (pointer ((t (nil)))) (primary-selection ((t (:background "blue")))) (red ((t (:foreground "red")))) (region ((t (:background "blue")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "darkslateblue" :foreground "white")))) (template-message-face ((t (:bold t)))) (text-cursor ((t (:background "yellow" :foreground "#9dcec9")))) (toolbar ((t (nil)))) (underline ((t (:underline t)))) (vertical-divider ((t (nil)))) (widget ((t (nil)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "forestgreen")))) (widget-field-face ((t (:background "gray")))) (widget-inactive-face ((t (:foreground "dimgray")))) (widget-single-line-field-face ((t (:background "dim gray" :foreground "white")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "blue"))))))) (defun color-theme-blue-erc () "Color theme for erc faces only. This is intended for other color themes to use (eg. `color-theme-gnome2')." (color-theme-install '(color-theme-blue-erc nil (erc-action-face ((t (nil)))) (erc-bold-face ((t (:bold t)))) (erc-current-nick-face ((t (:bold t :foreground "yellow")))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "pale green")))) (erc-error-face ((t (:bold t :foreground "IndianRed")))) (erc-highlight-face ((t (:bold t :foreground "pale green")))) (erc-input-face ((t (:foreground "light blue")))) (erc-inverse-face ((t (:background "steel blue")))) (erc-keyword-face ((t (:foreground "orange" :bold t)))) (erc-notice-face ((t (:foreground "light salmon")))) (erc-notice-face ((t (:foreground "MediumAquamarine")))) (erc-pal-face ((t (:foreground "pale green")))) (erc-prompt-face ((t (:foreground "light blue" :bold t)))) (fg:erc-color-face0 ((t (:foreground "white")))) (fg:erc-color-face1 ((t (:foreground "beige")))) (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) (fg:erc-color-face3 ((t (:foreground "light cyan")))) (fg:erc-color-face4 ((t (:foreground "powder blue")))) (fg:erc-color-face5 ((t (:foreground "sky blue")))) (fg:erc-color-face6 ((t (:foreground "dark sea green")))) (fg:erc-color-face7 ((t (:foreground "pale green")))) (fg:erc-color-face8 ((t (:foreground "medium spring green")))) (fg:erc-color-face9 ((t (:foreground "khaki")))) (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) (fg:erc-color-face12 ((t (:foreground "light yellow")))) (fg:erc-color-face13 ((t (:foreground "yellow")))) (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) (fg:erc-color-face15 ((t (:foreground "lime green")))) (bg:erc-color-face0 ((t (nil)))) (bg:erc-color-face1 ((t (nil)))) (bg:erc-color-face2 ((t (nil)))) (bg:erc-color-face3 ((t (nil)))) (bg:erc-color-face4 ((t (nil)))) (bg:erc-color-face5 ((t (nil)))) (bg:erc-color-face6 ((t (nil)))) (bg:erc-color-face7 ((t (nil)))) (bg:erc-color-face8 ((t (nil)))) (bg:erc-color-face9 ((t (nil)))) (bg:erc-color-face10 ((t (nil)))) (bg:erc-color-face11 ((t (nil)))) (bg:erc-color-face12 ((t (nil)))) (bg:erc-color-face13 ((t (nil)))) (bg:erc-color-face14 ((t (nil)))) (bg:erc-color-face15 ((t (nil))))))) (defun color-theme-dark-erc () "Color theme for erc faces only. This is intended for other color themes to use (eg. `color-theme-late-night')." (interactive) (color-theme-install '(color-theme-dark-erc nil (erc-action-face ((t (nil)))) (erc-bold-face ((t (:bold t)))) (erc-current-nick-face ((t (:bold t)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (nil)))) (erc-error-face ((t (:bold t :foreground "IndianRed")))) (erc-highlight-face ((t (:bold t :foreground "pale green")))) (erc-input-face ((t (:foreground "#555")))) (erc-inverse-face ((t (:background "steel blue")))) (erc-keyword-face ((t (:foreground "#999" :bold t)))) (erc-nick-msg-face ((t (:foreground "#888")))) (erc-notice-face ((t (:foreground "#444")))) (erc-pal-face ((t (:foreground "#888")))) (erc-prompt-face ((t (:foreground "#777" :bold t)))) (erc-timestamp-face ((t (:foreground "#777" :bold t)))) (fg:erc-color-face0 ((t (:foreground "white")))) (fg:erc-color-face1 ((t (:foreground "beige")))) (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) (fg:erc-color-face3 ((t (:foreground "light cyan")))) (fg:erc-color-face4 ((t (:foreground "powder blue")))) (fg:erc-color-face5 ((t (:foreground "sky blue")))) (fg:erc-color-face6 ((t (:foreground "dark sea green")))) (fg:erc-color-face7 ((t (:foreground "pale green")))) (fg:erc-color-face8 ((t (:foreground "medium spring green")))) (fg:erc-color-face9 ((t (:foreground "khaki")))) (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) (fg:erc-color-face12 ((t (:foreground "light yellow")))) (fg:erc-color-face13 ((t (:foreground "yellow")))) (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) (fg:erc-color-face15 ((t (:foreground "lime green")))) (bg:erc-color-face0 ((t (nil)))) (bg:erc-color-face1 ((t (nil)))) (bg:erc-color-face2 ((t (nil)))) (bg:erc-color-face3 ((t (nil)))) (bg:erc-color-face4 ((t (nil)))) (bg:erc-color-face5 ((t (nil)))) (bg:erc-color-face6 ((t (nil)))) (bg:erc-color-face7 ((t (nil)))) (bg:erc-color-face8 ((t (nil)))) (bg:erc-color-face9 ((t (nil)))) (bg:erc-color-face10 ((t (nil)))) (bg:erc-color-face11 ((t (nil)))) (bg:erc-color-face12 ((t (nil)))) (bg:erc-color-face13 ((t (nil)))) (bg:erc-color-face14 ((t (nil)))) (bg:erc-color-face15 ((t (nil))))))) (defun color-theme-subtle-blue () "Color theme by Chris McMahan, created 2001-09-06. Light blue background. Includes bbdb, comint, cperl, custom, cvs, diary, dired, display-time, ecb, ediff, erc, eshell, font-lock, gnus, html-helper, info, isearch, jde, message, paren, semantic, sgml, speedbar, term, vhdl, viper, vm, widget, woman, xref, xxml." (interactive) (color-theme-install '(color-theme-subtle-blue ((background-color . "#65889C") (background-mode . dark) (background-toolbar-color . "#cf3ccf3ccf3c") (border-color . "black") (bottom-toolbar-shadow-color . "#79e77df779e7") (cursor-color . "white") (foreground-color . "#eedfcc") (mouse-color . "Grey") (top-toolbar-shadow-color . "#fffffbeeffff") (viper-saved-cursor-color-in-replace-mode . "Red3")) ((blank-space-face . blank-space-face) (blank-tab-face . blank-tab-face) (ecb-source-in-directories-buffer-face . ecb-sources-face) (gnus-mouse-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight) (vm-highlight-url-face . my-url-face) (vm-highlighted-header-face . my-url-face) (vm-mime-button-face . gui-button-face) (vm-summary-highlight-face . my-summary-highlight-face)) (default ((t (nil)))) (bbdb-company ((t (:italic t)))) (bbdb-field-name ((t (:bold t :foreground "MediumAquamarine")))) (bbdb-field-value ((t (nil)))) (bbdb-name ((t (:underline t)))) (blank-space-face ((t (:background "gray80")))) (blank-tab-face ((t (:background "LightBlue" :foreground "DarkSlateGray")))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t :foreground "MediumAquamarine")))) (bold-italic ((t (:italic t :bold t :foreground "SkyBlue")))) (border ((t (:background "black")))) (border-glyph ((t (nil)))) (calendar-today-face ((t (:underline t)))) (comint-highlight-input ((t (:bold t)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (comint-input-face ((t (:foreground "deepskyblue")))) (cperl-array-face ((t (:bold t :foreground "Yellow")))) (cperl-hash-face ((t (:italic t :bold t :foreground "White")))) (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) (cursor ((t (:background "white")))) (custom-button-face ((t (:underline t :bold t :foreground "MediumAquaMarine")))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black")))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "dim gray")))) (custom-comment-tag-face ((t (:foreground "gray80")))) (custom-documentation-face ((t (:foreground "Grey")))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:bold t :foreground "MediumAquamarine")))) (custom-group-tag-face-1 ((t (:foreground "MediumAquaMarine")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "yellow")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:bold t :foreground "Aquamarine")))) (cvs-filename-face ((t (:foreground "blue4")))) (cvs-handled-face ((t (:foreground "pink")))) (cvs-header-face ((t (:bold t :foreground "blue4")))) (cvs-marked-face ((t (:bold t :foreground "green3")))) (cvs-msg-face ((t (:italic t)))) (cvs-need-action-face ((t (:foreground "orange")))) (cvs-unknown-face ((t (:foreground "red")))) (diary-face ((t (:bold t :foreground "cyan")))) (dired-face-boring ((t (:foreground "Gray65")))) (dired-face-directory ((t (:bold t :foreground "sky blue")))) (dired-face-executable ((t (:foreground "MediumAquaMarine")))) (dired-face-flagged ((t (:foreground "Cyan")))) (dired-face-marked ((t (:foreground "cyan")))) (dired-face-permissions ((t (:foreground "aquamarine")))) (dired-face-setuid ((t (:foreground "LightSalmon")))) (dired-face-socket ((t (:foreground "LightBlue")))) (dired-face-symlink ((t (:foreground "gray95")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "red")))) (ecb-sources-face ((t (:foreground "LightBlue1")))) (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "indianred" :foreground "white")))) (ediff-even-diff-face-A ((t (:background "light gray" :foreground "Black")))) (ediff-even-diff-face-Ancestor ((t (:background "Gray" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Gray" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light gray" :foreground "Black")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) (ediff-odd-diff-face-A ((t (:background "Gray" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light gray" :foreground "Black")))) (ediff-odd-diff-face-B ((t (:background "light gray" :foreground "Black")))) (ediff-odd-diff-face-C ((t (:background "Gray" :foreground "White")))) (erc-action-face ((t (:bold t)))) (erc-bold-face ((t (:bold t)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "LightSalmon")))) (erc-error-face ((t (:bold t :foreground "yellow")))) (erc-input-face ((t (:foreground "Beige")))) (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) (erc-notice-face ((t (:foreground "MediumAquamarine")))) (erc-pal-face ((t (:foreground "PaleGreen")))) (erc-prompt-face ((t (:foreground "MediumAquamarine")))) (erc-underline-face ((t (:underline t)))) (eshell-ls-archive-face ((t (:bold t :foreground "wheat")))) (eshell-ls-backup-face ((t (:foreground "Grey")))) (eshell-ls-clutter-face ((t (:bold t :foreground "wheat")))) (eshell-ls-directory-face ((t (:bold t :foreground "Yellow")))) (eshell-ls-executable-face ((t (:bold t :foreground "wheat")))) (eshell-ls-missing-face ((t (:bold t :foreground "wheat")))) (eshell-ls-picture-face ((t (:foreground "wheat")))) (eshell-ls-product-face ((t (:foreground "wheat")))) (eshell-ls-readonly-face ((t (:foreground "wheat")))) (eshell-ls-special-face ((t (:bold t :foreground "wheat")))) (eshell-ls-symlink-face ((t (:bold t :foreground "White")))) (eshell-ls-text-face ((t (:foreground "wheat")))) (eshell-ls-todo-face ((t (:foreground "wheat")))) (eshell-ls-unreadable-face ((t (:foreground "wheat3")))) (eshell-prompt-face ((t (:bold t :foreground "PaleGreen")))) (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) (eshell-test-ok-face ((t (:bold t :foreground "Green")))) (excerpt ((t (:italic t)))) (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) (font-latex-italic-face ((t (nil)))) (font-latex-math-face ((t (nil)))) (font-latex-sedate-face ((t (:foreground "Gray85")))) (font-latex-string-face ((t (:foreground "orange")))) (font-latex-warning-face ((t (:foreground "gold")))) (font-lock-builtin-face ((t (:foreground "PaleGreen")))) (font-lock-comment-face ((t (:italic t :foreground "Wheat3")))) (font-lock-constant-face ((t (:foreground "LightBlue")))) (font-lock-doc-face ((t (:bold t :foreground "DarkSeaGreen")))) (font-lock-doc-string-face ((t (:bold t :foreground "DarkSeaGreen")))) (font-lock-exit-face ((t (:foreground "green")))) (font-lock-function-name-face ((t (:italic t :bold t :foreground "cyan")))) (font-lock-keyword-face ((t (:bold t :foreground "LightBlue")))) (font-lock-preprocessor-face ((t (:foreground "blue3")))) (font-lock-reference-face ((t (:foreground "PaleGreen")))) (font-lock-string-face ((t (:italic t :foreground "MediumAquamarine")))) (font-lock-type-face ((t (:bold t :foreground "LightBlue")))) (font-lock-variable-name-face ((t (:italic t :bold t :foreground "LightBlue")))) (font-lock-warning-face ((t (:bold t :foreground "LightSalmon")))) (fringe ((t (:background "darkslategrey")))) (gnus-cite-attribution-face ((t (:italic t :bold t)))) (gnus-cite-face-1 ((t (:foreground "LightBlue")))) (gnus-cite-face-10 ((t (:foreground "LightBlue")))) (gnus-cite-face-11 ((t (:foreground "LightBlue")))) (gnus-cite-face-2 ((t (:foreground "LightBlue")))) (gnus-cite-face-3 ((t (:foreground "LightBlue")))) (gnus-cite-face-4 ((t (:foreground "LightBlue")))) (gnus-cite-face-5 ((t (:foreground "LightBlue")))) (gnus-cite-face-6 ((t (:foreground "LightBlue")))) (gnus-cite-face-7 ((t (:foreground "LightBlue")))) (gnus-cite-face-8 ((t (:foreground "LightBlue")))) (gnus-cite-face-9 ((t (:foreground "LightBlue")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) (gnus-filterhist-face-1 ((t (nil)))) (gnus-group-mail-1-empty-face ((t (:foreground "gray80")))) (gnus-group-mail-1-face ((t (:bold t :foreground "light cyan")))) (gnus-group-mail-2-empty-face ((t (:foreground "gray80")))) (gnus-group-mail-2-face ((t (:bold t :foreground "turquoise")))) (gnus-group-mail-3-empty-face ((t (:foreground "gray80")))) (gnus-group-mail-3-face ((t (:bold t :foreground "LightBlue")))) (gnus-group-mail-low-empty-face ((t (:foreground "gray80")))) (gnus-group-mail-low-face ((t (:bold t :foreground "LightBlue")))) (gnus-group-news-1-empty-face ((t (:foreground "gray80")))) (gnus-group-news-1-face ((t (:bold t :foreground "green yellow")))) (gnus-group-news-2-empty-face ((t (:foreground "gray80")))) (gnus-group-news-2-face ((t (:bold t :foreground "Aquamarine")))) (gnus-group-news-3-empty-face ((t (:foreground "gray80")))) (gnus-group-news-3-face ((t (:bold t :foreground "LightBlue")))) (gnus-group-news-4-empty-face ((t (:foreground "gray80")))) (gnus-group-news-4-face ((t (:bold t :foreground "Wheat")))) (gnus-group-news-5-empty-face ((t (:foreground "gray80")))) (gnus-group-news-5-face ((t (:bold t :foreground "MediumAquamarine")))) (gnus-group-news-6-empty-face ((t (:foreground "gray80")))) (gnus-group-news-6-face ((t (:bold t :foreground "MediumAquamarine")))) (gnus-group-news-low-empty-face ((t (:foreground "gray80")))) (gnus-group-news-low-face ((t (:bold t :foreground "yellow green")))) (gnus-header-content-face ((t (:italic t :foreground "LightSkyBlue3")))) (gnus-header-from-face ((t (:bold t :foreground "light cyan")))) (gnus-header-name-face ((t (:bold t :foreground "LightBlue")))) (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) (gnus-header-subject-face ((t (:bold t :foreground "light cyan")))) (gnus-picons-face ((t (:background "white" :foreground "black")))) (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) (gnus-signature-face ((t (:italic t :foreground "LightBlue")))) (gnus-splash ((t (:foreground "Brown")))) (gnus-splash-face ((t (:foreground "LightBlue")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "gray80")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "LightBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "gray80")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "burlywood")))) (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "wheat")))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "LightBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "light sea green")))) (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "LightBlue")))) (gnus-summary-low-unread-face ((t (:italic t :foreground "light sea green")))) (gnus-summary-normal-ancient-face ((t (:foreground "gray80")))) (gnus-summary-normal-read-face ((t (:foreground "gray80")))) (gnus-summary-normal-ticked-face ((t (:bold t :foreground "sandy brown")))) (gnus-summary-normal-unread-face ((t (:bold t :foreground "wheat")))) (gnus-summary-selected-face ((t (:underline t)))) (gnus-x-face ((t (:background "white" :foreground "black")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "cyan" :foreground "#65889C")))) (gui-element ((t (:background "Gray")))) (header-line ((t (:background "grey20" :foreground "grey90")))) (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) (highlight-changes-delete-face ((t (:underline t :foreground "red")))) (highlight-changes-face ((t (:foreground "red")))) (highline-face ((t (:background "SeaGreen")))) (holiday-face ((t (:background "DimGray")))) (html-helper-bold-face ((t (:foreground "DarkRed")))) (html-helper-italic-face ((t (:foreground "DarkBlue")))) (html-helper-underline-face ((t (:underline t :foreground "Black")))) (html-tag-face ((t (:foreground "Blue")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:underline t :italic t :bold t :foreground "light blue")))) (info-xref ((t (:bold t :foreground "light blue")))) (isearch ((t (:background "Aquamarine" :foreground "SteelBlue")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (:italic t)))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) (jde-java-font-lock-api-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-bold-face ((t (:bold t)))) (jde-java-font-lock-code-face ((t (nil)))) (jde-java-font-lock-constant-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-doc-tag-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-italic-face ((t (:italic t)))) (jde-java-font-lock-link-face ((t (:underline t :foreground "LightBlue")))) (jde-java-font-lock-modifier-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-number-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-package-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-pre-face ((t (nil)))) (jde-java-font-lock-underline-face ((t (:underline t)))) (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) (left-margin ((t (nil)))) (linemenu-face ((t (:background "gray30")))) (list-mode-item-selected ((t (nil)))) (makefile-space-face ((t (:background "hotpink")))) (menu ((t (:background "wheat" :foreground "gray30")))) (message-cited-text-face ((t (:foreground "White")))) (message-header-cc-face ((t (:bold t :foreground "light cyan")))) (message-header-name-face ((t (:foreground "LightBlue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3")))) (message-header-other-face ((t (:foreground "LightSkyBlue3")))) (message-header-subject-face ((t (:bold t :foreground "light cyan")))) (message-header-to-face ((t (:bold t :foreground "light cyan")))) (message-header-xheader-face ((t (:foreground "LightBlue")))) (message-mml-face ((t (:bold t :foreground "LightBlue")))) (message-separator-face ((t (:foreground "LightBlue")))) (mmm-default-submode-face ((t (:background "#c0c0c5")))) (modeline ((t (:background "#4f657d" :foreground "gray80")))) (modeline-buffer-id ((t (:background "#4f657d" :foreground "gray80")))) (modeline-mousable ((t (:background "#4f657d" :foreground "gray80")))) (modeline-mousable-minor-mode ((t (:background "#4f657d" :foreground "gray80")))) (mouse ((t (:background "Grey")))) (my-summary-highlight-face ((t (:foreground "White")))) (my-url-face ((t (:foreground "PaleTurquoise")))) (nil ((t (nil)))) (paren-blink-off ((t (:foreground "gray")))) (paren-face-match ((t (:background "turquoise")))) (paren-face-mismatch ((t (:background "purple" :foreground "white")))) (paren-face-no-match ((t (:background "yellow" :foreground "black")))) (paren-match ((t (:background "darkseagreen2")))) (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) (paren-mismatch-face ((t (:bold t)))) (paren-no-match-face ((t (:bold t)))) (pointer ((t (nil)))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (region ((t (:background "CadetBlue" :foreground "gray80")))) (right-margin ((t (nil)))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "LightBlue" :foreground "#4f657d")))) (semantic-dirty-token-face ((t (:background "gray10")))) (semantic-intangible-face ((t (:foreground "gray25")))) (semantic-read-only-face ((t (:background "gray25")))) (senator-intangible-face ((t (:foreground "gray75")))) (senator-momentary-highlight-face ((t (:background "gray80")))) (senator-read-only-face ((t (:background "#664444")))) (sgml-comment-face ((t (:foreground "dark turquoise")))) (sgml-doctype-face ((t (:foreground "red")))) (sgml-end-tag-face ((t (:foreground "blue")))) (sgml-entity-face ((t (:foreground "magenta")))) (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) (sgml-ms-end-face ((t (:foreground "green")))) (sgml-ms-start-face ((t (:foreground "yellow")))) (sgml-pi-face ((t (:foreground "lime green")))) (sgml-sgml-face ((t (:foreground "brown")))) (sgml-short-ref-face ((t (:foreground "deep sky blue")))) (sgml-start-tag-face ((t (:foreground "dark green")))) (shell-option-face ((t (:foreground "blue")))) (shell-output-2-face ((t (:foreground "darkseagreen")))) (shell-output-3-face ((t (:foreground "slategray")))) (shell-output-face ((t (:foreground "palegreen")))) (shell-prompt-face ((t (:foreground "red")))) (show-paren-match-face ((t (:background "Aquamarine" :foreground "steel blue")))) (show-paren-mismatch-face ((t (:bold t :background "IndianRed" :foreground "White")))) (speedbar-button-face ((t (:bold t :foreground "LightBlue")))) (speedbar-directory-face ((t (:bold t :foreground "yellow")))) (speedbar-file-face ((t (:bold t :foreground "wheat")))) (speedbar-highlight-face ((t (:background "sea green")))) (speedbar-selected-face ((t (:underline t)))) (speedbar-tag-face ((t (:foreground "LightBlue")))) (swbuff-current-buffer-face ((t (:bold t :foreground "red")))) (template-message-face ((t (:bold t)))) (term-black ((t (:foreground "black")))) (term-blackbg ((t (:background "black")))) (term-blue ((t (:foreground "blue")))) (term-bluebg ((t (:background "blue")))) (term-bold ((t (:bold t)))) (term-cyan ((t (:foreground "cyan")))) (term-cyanbg ((t (:background "cyan")))) (term-default-bg ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-default-fg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-green ((t (:foreground "green")))) (term-greenbg ((t (:background "green")))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-magenta ((t (:foreground "magenta")))) (term-magentabg ((t (:background "magenta")))) (term-red ((t (:foreground "red")))) (term-redbg ((t (:background "red")))) (term-underline ((t (:underline t)))) (term-white ((t (:foreground "white")))) (term-whitebg ((t (:background "white")))) (term-yellow ((t (:foreground "yellow")))) (term-yellowbg ((t (:background "yellow")))) (text-cursor ((t (:background "Red3" :foreground "white")))) (tool-bar ((t (:background "grey75" :foreground "black")))) (toolbar ((t (:background "Gray")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (nil)))) (vc-annotate-face-0046FF ((t (:background "black" :foreground "wheat")))) (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) (vertical-divider ((t (:background "Gray")))) (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) (vhdl-speedbar-package-face ((t (:foreground "Gray50")))) (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Gray50")))) (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) (viper-minibuffer-vi-face ((t (:background "gray" :foreground "DarkGreen")))) (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-search-face ((t (:background "khaki" :foreground "Black")))) (vm-header-content-face ((t (:italic t :foreground "gray80")))) (vm-header-from-face ((t (:italic t :background "#65889C" :foreground "cyan")))) (vm-header-name-face ((t (:foreground "cyan")))) (vm-header-subject-face ((t (:foreground "cyan")))) (vm-header-to-face ((t (:italic t :foreground "cyan")))) (vm-message-cited-face ((t (:foreground "Gray80")))) (vm-summary-face-1 ((t (:foreground "MediumAquamarine")))) (vm-summary-face-2 ((t (:foreground "MediumAquamarine")))) (vm-summary-face-3 ((t (:foreground "MediumAquamarine")))) (vm-summary-face-4 ((t (:foreground "MediumAquamarine")))) (vm-summary-highlight-face ((t (:foreground "White")))) (vmpc-pre-sig-face ((t (:foreground "Aquamarine")))) (vmpc-sig-face ((t (:foreground "LightBlue")))) (vvb-face ((t (:background "pink" :foreground "black")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "cyan")))) (widget-documentation-face ((t (:foreground "LightBlue")))) (widget-field-face ((t (:foreground "LightBlue")))) (widget-inactive-face ((t (:foreground "Wheat3")))) (widget-single-line-field-face ((t (:foreground "LightBlue")))) (woman-bold-face ((t (:bold t)))) (woman-italic-face ((t (:foreground "beige")))) (woman-unknown-face ((t (:foreground "LightSalmon")))) (xref-keyword-face ((t (:foreground "Cyan")))) (xref-list-pilot-face ((t (:foreground "navy")))) (xref-list-symbol-face ((t (:foreground "navy")))) (xxml-emph-1-face ((t (:background "lightyellow")))) (xxml-emph-2-face ((t (:background "lightyellow")))) (xxml-header-1-face ((t (:background "seashell1" :foreground "MediumAquamarine")))) (xxml-header-2-face ((t (:background "seashell1" :foreground "SkyBlue")))) (xxml-header-3-face ((t (:background "seashell1")))) (xxml-header-4-face ((t (:background "seashell1")))) (xxml-interaction-face ((t (:background "lightcyan")))) (xxml-rug-face ((t (:background "cyan")))) (xxml-sparkle-face ((t (:background "yellow")))) (xxml-unbreakable-space-face ((t (:underline t :foreground "grey")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "#4f657d"))))))) (defun color-theme-dark-blue () "Color theme by Chris McMahan, created 2001-09-09. Based on `color-theme-subtle-blue' with a slightly darker background." (interactive) (color-theme-subtle-blue) (let ((color-theme-is-cumulative t)) (color-theme-install '(color-theme-dark-blue ((background-color . "#537182") (foreground-color . "AntiqueWhite2")) nil (default ((t (nil)))) (blank-space-face ((t (:background "LightGray")))) (blank-tab-face ((t (:background "Wheat" :foreground "DarkSlateGray")))) (cursor ((t (:background "LightGray")))) (dired-face-executable ((t (:foreground "green yellow")))) (dired-face-flagged ((t (:foreground "tomato")))) (dired-face-marked ((t (:foreground "light salmon")))) (dired-face-setuid ((t (:foreground "Red")))) (dired-face-socket ((t (:foreground "magenta")))) (fixed ((t (:bold t)))) (font-lock-comment-face ((t (:italic t :foreground "Gray80")))) (font-lock-doc-face ((t (:bold t)))) (font-lock-function-name-face ((t (:italic t :bold t :foreground "Yellow")))) (font-lock-string-face ((t (:italic t :foreground "DarkSeaGreen")))) (font-lock-type-face ((t (:bold t :foreground "YellowGreen")))) (gui-button-face ((t (:background "DarkSalmon" :foreground "white")))) (modeline ((t (:background "#c1ccd9" :foreground "#4f657d")))) (modeline-buffer-id ((t (:background "#c1ccd9" :foreground "#4f657d")))) (modeline-mousable ((t (:background "#c1ccd9" :foreground "#4f657d")))) (modeline-mousable-minor-mode ((t (:background "#c1ccd9" :foreground "#4f657d")))) (my-url-face ((t (:foreground "LightBlue")))) (region ((t (:background "PaleTurquoise4" :foreground "gray80")))) (secondary-selection ((t (:background "sea green" :foreground "yellow")))) (vm-header-content-face ((t (:italic t :foreground "wheat")))) (vm-header-from-face ((t (:italic t :foreground "wheat")))) (widget-button-pressed-face ((t (:foreground "red")))) (xref-keyword-face ((t (:foreground "blue")))) (zmacs-region ((t (:background "SlateGray")))))))) (defun color-theme-jonadabian-slate () "Another slate-and-wheat color theme by Jonadab the Unsightly One. Updated 2001-10-12." (interactive) (color-theme-install '(color-theme-jonadabian-slate ((background-color . "#305050") (background-mode . dark) (border-color . "black") (cursor-color . "medium turquoise") (foreground-color . "#CCBB77") (mouse-color . "black")) ((list-matching-lines-face . bold) (ued-mode-keyname-face . modeline) (view-highlight-face . highlight)) (default ((t (nil)))) (fringe ((t (:background "#007080")))) (bold ((t (:bold t :foreground "#EEDDAA")))) (gnus-emphasis-bold ((t (:bold t :foreground "#EEDDAA")))) (gnus-emphasis-underline-bold ((t (:underline t :bold t :foreground "#EEDDAA")))) (bold-italic ((t (:italic t :bold t :foreground "#AA0000")))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "#AA0000")))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t :foreground "#AA0000")))) (gnus-emphasis-underline-italic ((t (:underline t :italic t :bold t :foreground "#AA0000")))) (calendar-today-face ((t (:underline t :background "darkslategrey")))) (cperl-array-face ((t (:background "#004060")))) (cperl-hash-face ((t (:background "#004400")))) (custom-button-face ((t (:background "dark blue" :foreground "rgbi:1.00/1.00/0.00")))) (custom-documentation-face ((t (:foreground "#10D010")))) (custom-face-tag-face ((t (:underline t :foreground "goldenrod")))) (custom-group-tag-face ((t (:underline t :foreground "light blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:foreground "#6666dd")))) (custom-state-face ((t (:foreground "mediumaquamarine")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "light blue")))) (diary-face ((t (:foreground "red")))) (eshell-ls-archive-face ((t (:foreground "green")))) (eshell-ls-backup-face ((t (:foreground "grey60")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) (eshell-ls-directory-face ((t (:bold t :foreground "SkyBlue")))) (eshell-ls-executable-face ((t (:foreground "white")))) (eshell-ls-missing-face ((t (:foreground "red")))) (eshell-ls-product-face ((t (:foreground "LightSalmon")))) (eshell-ls-readonly-face ((t (:foreground "indian red")))) (eshell-ls-special-face ((t (:foreground "yellow")))) (eshell-ls-symlink-face ((t (:foreground "#6666dd")))) (eshell-ls-unreadable-face ((t (:foreground "red")))) (eshell-prompt-face ((t (:bold t :background "#305050" :foreground "#EEDD99")))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:italic t :bold t :foreground "grey66")))) (font-lock-constant-face ((t (:foreground "indian red")))) (font-lock-function-name-face ((t (:foreground "#D0D000")))) (font-lock-keyword-face ((t (:foreground "#00BBBB")))) (font-lock-string-face ((t (:foreground "#10D010")))) (font-lock-type-face ((t (:bold t :foreground "#ff7788")))) (font-lock-variable-name-face ((t (:foreground "#eeddaa")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (header-line ((t (:box (:line-width 1 :style released-button))))) (highlight ((t (:background "#226644")))) (highlight-changes-delete-face ((t (:background "navy" :foreground "red")))) (highlight-changes-face ((t (:background "navy")))) (holiday-face ((t (:foreground "#ff7744")))) (italic ((t (:italic t :foreground "#AA0000")))) (gnus-emphasis-italic ((t (:italic t :foreground "#AA0000")))) (modeline ((t (:background "#007080" :foreground "cyan")))) (modeline-buffer-id ((t (:background "#007080" :foreground "cyan")))) (modeline-mousable ((t (:background "#007080" :foreground "cyan")))) (modeline-mousable-minor-mode ((t (:background "#007080" :foreground "cyan")))) (region ((t (:background "#226644")))) (secondary-selection ((t (:background "darkslategrey")))) (sgml-comment-face ((t (:foreground "grey60")))) (sgml-doctype-face ((t (:foreground "red")))) (sgml-end-tag-face ((t (:foreground "#00D0D0")))) (sgml-entity-face ((t (:foreground "indian red")))) (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) (sgml-ms-end-face ((t (:foreground "green")))) (sgml-ms-start-face ((t (:foreground "green")))) (sgml-pi-face ((t (:foreground "lime green")))) (sgml-sgml-face ((t (:foreground "brown")))) (sgml-short-ref-face ((t (:foreground "deep sky blue")))) (sgml-start-tag-face ((t (:foreground "#D0D000")))) (show-paren-match-face ((t (:background "#400055" :foreground "cyan")))) (show-paren-mismatch-face ((t (:background "red")))) (special-string-face ((t (:foreground "light green")))) (term-black ((t (:background "#000055" :foreground "black")))) (term-blackbg ((t (:background "black" :foreground "#CCBB77")))) (term-blue ((t (:background "#000055" :foreground "blue")))) (term-bluebg ((t (:background "blue" :foreground "#CCBB77")))) (term-bold ((t (:bold t :background "#000055" :foreground "#CCBB77")))) (term-cyan ((t (:background "#000055" :foreground "cyan")))) (term-cyanbg ((t (:background "darkcyan")))) (term-default-bg ((t (:foreground "#CCBB77")))) (term-default-bg-inv ((t (:foreground "#CCBB77")))) (term-default-fg ((t (:background "#000055")))) (term-default-fg-inv ((t (:background "#000055")))) (term-green ((t (:background "#000055" :foreground "green")))) (term-greenbg ((t (:background "darkgreen")))) (term-invisible ((t (:foreground "#CCBB77")))) (term-invisible-inv ((t (:foreground "#CCBB77")))) (term-magenta ((t (:background "#000055" :foreground "magenta")))) (term-magentabg ((t (:background "darkmagenta")))) (term-red ((t (:background "#000055" :foreground "red")))) (term-redbg ((t (:background "darkred")))) (term-underline ((t (:underline t :background "#000055" :foreground "#CCBB77")))) (term-white ((t (:background "#000055" :foreground "white")))) (term-whitebg ((t (:background "grey50")))) (term-yellow ((t (:background "#000055" :foreground "yellow")))) (term-yellowbg ((t (:background "#997700")))) (trailing-whitespace ((t (:background "#23415A")))) (underline ((t (:underline t)))) (gnus-emphasis-underline ((t (:underline t)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "green")))) (widget-field-face ((t (:background "grey35" :foreground "black")))) (widget-inactive-face ((t (:foreground "gray")))) (widget-single-line-field-face ((t (:background "dim gray"))))))) (defun color-theme-gray1 () "Color theme by Paul Pulli, created 2001-10-19." (interactive) (color-theme-install '(color-theme-gray1 ((background-color . "darkgray") (background-mode . light) (background-toolbar-color . "#949494949494") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#595959595959") (cursor-color . "Yellow") (foreground-color . "black") (top-toolbar-shadow-color . "#b2b2b2b2b2b2")) nil (default ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (border-glyph ((t (nil)))) (cperl-here-face ((t (:background "gray68" :foreground "DeepPink")))) (font-lock-builtin-face ((t (:bold t :foreground "red3")))) (font-lock-comment-face ((t (:foreground "gray50")))) (font-lock-constant-face ((t (:bold t :foreground "blue3")))) (font-lock-doc-string-face ((t (:foreground "black")))) (font-lock-function-name-face ((t (:bold t :foreground "DeepPink3")))) (font-lock-keyword-face ((t (:bold t :foreground "red")))) (font-lock-other-type-face ((t (:bold t :foreground "green4")))) (font-lock-preprocessor-face ((t (:bold t :foreground "blue3")))) (font-lock-reference-face ((t (:bold t :foreground "red3")))) (font-lock-string-face ((t (:foreground "red")))) (font-lock-type-face ((t (:bold t :foreground "white")))) (font-lock-variable-name-face ((t (:bold t :foreground "blue3")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (green ((t (:foreground "green4")))) (gui-button-face ((t (:background "black" :foreground "red")))) (gui-element ((t (:background "gray58")))) (highlight ((t (:background "magenta" :foreground "yellow")))) (isearch ((t (:background "red" :foreground "yellow")))) (italic ((t (:italic t)))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray90" :foreground "purple")))) (m4-face ((t (:background "gray90" :foreground "orange3")))) (message-cited-text ((t (nil)))) (message-header-contents ((t (nil)))) (message-headers ((t (nil)))) (message-highlighted-header-contents ((t (nil)))) (modeline ((t (:background "#aa80aa" :foreground "White")))) (modeline-buffer-id ((t (:background "#aa80aa" :foreground "linen")))) (modeline-mousable ((t (:background "#aa80aa" :foreground "cyan")))) (modeline-mousable-minor-mode ((t (:background "#aa80aa" :foreground "yellow")))) (paren-blink-off ((t (:foreground "gray58")))) (paren-blink-on ((t (:foreground "purple")))) (paren-match ((t (:background "gray68" :foreground "white")))) (paren-mismatch ((t (:background "DeepPink" :foreground "black")))) (pointer ((t (nil)))) (primary-selection ((t (:background "gray")))) (red ((t (:foreground "red")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "paleturquoise")))) (text-cursor ((t (:background "Yellow" :foreground "darkgray")))) (toolbar ((t (:background "#aa80aa" :foreground "linen")))) (underline ((t (:underline t)))) (vertical-divider ((t (nil)))) (x-face ((t (:background "black" :foreground "lavenderblush")))) (yellow ((t (:foreground "yellow3")))) (zmacs-region ((t (:background "paleturquoise" :foreground "black"))))))) (defun color-theme-word-perfect () "White on blue background, based on WordPerfect 5.1. Color theme by Thomas Gehrlein, created 2001-10-21." (interactive) (color-theme-install '(color-theme-word-perfect ((background-color . "blue4") (background-mode . dark) (border-color . "black") (cursor-color . "gold") (foreground-color . "white") (mouse-color . "black")) ((ecb-source-in-directories-buffer-face . ecb-sources-face) (gnus-mouse-face . highlight) (goto-address-mail-face . italic) (goto-address-mail-mouse-face . secondary-selection) (goto-address-url-face . bold) (goto-address-url-mouse-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight)) (default ((t (nil)))) (bbdb-field-name ((t (:foreground "lime green")))) (bbdb-field-value ((t (:foreground "white")))) (bbdb-name ((t (:underline t :foreground "lime green")))) (bold ((t (:bold t :foreground "white")))) (bold-italic ((t (:italic t :bold t :foreground "yellow")))) (calendar-today-face ((t (:underline t :foreground "deep sky blue")))) (diary-face ((t (:foreground "gold")))) (ecb-sources-face ((t (:foreground "LightBlue1")))) (edb-inter-field-face ((t (:foreground "deep sky blue")))) (edb-normal-summary-face ((t (:foreground "gold")))) (emacs-wiki-bad-link-face ((t (:underline "coral" :bold t :foreground "coral")))) (emacs-wiki-link-face ((t (:underline "cyan" :bold t :foreground "cyan")))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:foreground "deep sky blue")))) (font-lock-constant-face ((t (:foreground "lime green")))) (font-lock-doc-face ((t (:foreground "gold")))) (font-lock-doc-string-face ((t (:foreground "gold")))) (font-lock-function-name-face ((t (:background "blue4" :foreground "IndianRed")))) (font-lock-keyword-face ((t (:foreground "lime green")))) (font-lock-preprocessor-face ((t (:foreground "lime green")))) (font-lock-reference-face ((t (:foreground "LightSteelBlue")))) (font-lock-string-face ((t (:foreground "gold")))) (font-lock-type-face ((t (:foreground "lime green")))) (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "firebrick")))) (gnus-emphasis-bold ((t (:foreground "yellow2")))) (gnus-emphasis-bold-italic ((t (:foreground "yellow2")))) (gnus-emphasis-italic ((t (:foreground "yellow2")))) (gnus-emphasis-underline ((t (:foreground "yellow2")))) (gnus-emphasis-underline-bold ((t (:foreground "yellow2")))) (gnus-emphasis-underline-bold-italic ((t (:foreground "yellow2")))) (gnus-emphasis-underline-italic ((t (:foreground "yellow2")))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1")))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2")))) (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3")))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4")))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise")))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise")))) (gnus-group-news-3-empty-face ((t (:foreground "deep sky blue")))) (gnus-group-news-3-face ((t (:bold t :foreground "deep sky blue")))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise")))) (gnus-header-content-face ((t (:foreground "gold")))) (gnus-header-from-face ((t (:foreground "gold")))) (gnus-header-name-face ((t (:foreground "deep sky blue")))) (gnus-header-newsgroups-face ((t (:foreground "gold")))) (gnus-header-subject-face ((t (:foreground "gold")))) (gnus-signature-face ((t (:foreground "gold")))) (gnus-splash-face ((t (:foreground "firebrick")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "deep sky blue")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "deep sky blue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "deep sky blue")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "deep sky blue")))) (gnus-summary-high-unread-face ((t (:bold t :foreground "lime green")))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "deep sky blue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "deep sky blue")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "deep sky blue")))) (gnus-summary-low-unread-face ((t (:italic t :foreground "lime green")))) (gnus-summary-normal-ancient-face ((t (:foreground "deep sky blue")))) (gnus-summary-normal-read-face ((t (:foreground "deep sky blue")))) (gnus-summary-normal-ticked-face ((t (:foreground "deep sky blue")))) (gnus-summary-normal-unread-face ((t (:foreground "lime green")))) (gnus-summary-selected-face ((t (:underline t :foreground "gold")))) (highlight ((t (:background "steel blue" :foreground "black")))) (holiday-face ((t (:background "blue4" :foreground "IndianRed1")))) (info-menu-5 ((t (:underline t :foreground "gold")))) (info-node ((t (:italic t :bold t :foreground "gold")))) (info-xref ((t (:bold t :foreground "gold")))) (isearch ((t (:background "firebrick" :foreground "white")))) (italic ((t (:italic t :foreground "yellow2")))) (message-cited-text-face ((t (:foreground "gold")))) (message-header-cc-face ((t (:bold t :foreground "green4")))) (message-header-name-face ((t (:foreground "deep sky blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "gold")))) (message-header-other-face ((t (:foreground "gold")))) (message-header-subject-face ((t (:foreground "gold")))) (message-header-to-face ((t (:bold t :foreground "gold")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-separator-face ((t (:foreground "lime green")))) (modeline ((t (:foreground "white" :background "black")))) (modeline-buffer-id ((t (:foreground "white" :background "black")))) (modeline-mousable ((t (:foreground "white" :background "black")))) (modeline-mousable-minor-mode ((t (:foreground "white" :background "black")))) (overlay-empty-face ((t (nil)))) (primary-selection ((t (:background "firebrick" :foreground "white")))) (region ((t (:background "firebrick" :foreground "white")))) (secondary-selection ((t (:background "yellow2" :foreground "black")))) (semantic-dirty-token-face ((t (:background "gray10")))) (show-paren-match-face ((t (:background "deep sky blue" :foreground "black")))) (show-paren-mismatch-face ((t (:background "firebrick" :foreground "white")))) (underline ((t (:underline t :background "blue4" :foreground "white"))))))) ;; In order to produce this, follow these steps: ;; ;; 0. Make sure .Xresources and .Xdefaults don't have any Emacs related ;; entries. ;; ;; 1. cd into the Emacs lisp directory and run the following command: ;; ( for d in `find -type d`; \ ;; do grep --files-with-matches 'defface[ ]' $d/*.el; \ ;; done ) | sort | uniq ;; Put the result in a lisp block, using load-library calls. ;; ;; Repeat this for any directories on your load path which you want to ;; include in the standard. This might include W3, eshell, etc. ;; ;; Add some of the libraries that don't use defface: ;; ;; 2. Start emacs using the --no-init-file and --no-site-file command line ;; arguments. Evaluate the lisp block you prepared. ;; 3. Load color-theme and run color-theme-print. Save the output and use it ;; to define color-theme-standard. ;; ;; (progn ;; (load-library "add-log") ;; (load-library "calendar") ;; (load-library "comint") ;; (load-library "cus-edit") ;; (load-library "cus-face") ;; (load-library "custom") ;; (load-library "diff-mode") ;; (load-library "ediff-init") ;; (load-library "re-builder") ;; (load-library "viper-init") ;; (load-library "enriched") ;; (load-library "em-ls") ;; (load-library "em-prompt") ;; (load-library "esh-test") ;; (load-library "faces") ;; (load-library "font-lock") ;; (load-library "generic-x") ;; (load-library "gnus-art") ;; (load-library "gnus-cite") ;; (load-library "gnus") ;; (load-library "message") ;; (load-library "hilit-chg") ;; (load-library "hi-lock") ;; (load-library "info") ;; (load-library "isearch") ;; (load-library "log-view") ;; (load-library "paren") ;; (load-library "pcvs-info") ;; (load-library "antlr-mode") ;; (load-library "cperl-mode") ;; (load-library "ebrowse") ;; (load-library "idlwave") ;; (load-library "idlw-shell") ;; (load-library "make-mode") ;; (load-library "sh-script") ;; (load-library "vhdl-mode") ;; (load-library "smerge-mode") ;; (load-library "speedbar") ;; (load-library "strokes") ;; (load-library "artist") ;; (load-library "flyspell") ;; (load-library "texinfo") ;; (load-library "tex-mode") ;; (load-library "tooltip") ;; (load-library "vcursor") ;; (load-library "wid-edit") ;; (load-library "woman") ;; (load-library "term") ;; (load-library "man") ;; (load-file "/home/alex/elisp/color-theme.el") ;; (color-theme-print)) ;; ;; 4. Make the color theme usable on Xemacs (add more faces, resolve ;; :inherit attributes) ;; (defun color-theme-emacs-21 () "Color theme used by Emacs 21.1. Added and adapted for XEmacs by Alex Schroeder. Adaptation mostly consisted of resolving :inherit attributes and adding missing faces. This theme includes faces from the following Emacs libraries: add-log calendar comint cus-edit cus-face custom diff-mode ediff-init re-builder viper-init enriched em-ls em-prompt esh-test faces font-lock generic-x gnus-art gnus-cite gnus message hilit-chg hi-lock info isearch log-view paren pcvs-info antlr-mode cperl-mode ebrowse idlwave idlw-shell make-mode sh-script vhdl-mode smerge-mode speedbar strokes artist flyspell texinfo tex-mode tooltip vcursor wid-edit woman term man" (interactive) (color-theme-install '(color-theme-emacs-21 ((background-color . "white") (background-mode . light) (border-color . "black") (cursor-color . "black") (foreground-color . "black") (mouse-color . "black")) ((Man-overstrike-face . bold) (Man-underline-face . underline) (cperl-here-face . font-lock-string-face) (cperl-invalid-face . underline) (cperl-pod-face . font-lock-comment-face) (cperl-pod-head-face . font-lock-variable-name-face) (gnus-article-button-face . bold) (gnus-article-mouse-face . highlight) (gnus-cite-attribution-face . gnus-cite-attribution-face) (gnus-mouse-face . highlight) (gnus-signature-face . gnus-signature-face) (gnus-summary-selected-face . gnus-summary-selected-face) (help-highlight-face . underline) (idlwave-class-arrow-face . bold) (idlwave-shell-breakpoint-face . idlwave-shell-bp-face) (idlwave-shell-expression-face . secondary-selection) (idlwave-shell-stop-line-face . highlight) (ispell-highlight-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight) (viper-insert-state-cursor-color . "Green") (viper-replace-overlay-cursor-color . "Red") (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) (antlr-font-lock-keyword-face ((t (:bold t :foreground "black" :weight bold)))) (antlr-font-lock-literal-face ((t (:bold t :foreground "brown4" :weight bold)))) (antlr-font-lock-ruledef-face ((t (:bold t :foreground "blue" :weight bold)))) (antlr-font-lock-ruleref-face ((t (:foreground "blue4")))) (antlr-font-lock-tokendef-face ((t (:bold t :foreground "blue" :weight bold)))) (antlr-font-lock-tokenref-face ((t (:foreground "orange4")))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (calendar-today-face ((t (:underline t)))) (change-log-acknowledgement-face ((t (:foreground "Firebrick")))) (change-log-conditionals-face ((t (:foreground "DarkGoldenrod")))) (change-log-date-face ((t (:foreground "RosyBrown")))) (change-log-email-face ((t (:foreground "DarkGoldenrod")))) (change-log-file-face ((t (:foreground "Blue")))) (change-log-function-face ((t (:foreground "DarkGoldenrod")))) (change-log-list-face ((t (:foreground "Purple")))) (change-log-name-face ((t (:foreground "CadetBlue")))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "dark blue")))) (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (cursor ((t (:background "black")))) (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "gray85")))) (custom-comment-tag-face ((t (:foreground "blue4")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) (cvs-filename-face ((t (:foreground "blue4")))) (cvs-handled-face ((t (:foreground "pink")))) (cvs-header-face ((t (:bold t :foreground "blue4" :weight bold)))) (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) (cvs-msg-face ((t (:italic t :slant italic)))) (cvs-need-action-face ((t (:foreground "orange")))) (cvs-unknown-face ((t (:foreground "red")))) (diary-face ((t (:foreground "red")))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-context-face ((t (:foreground "grey50")))) (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) (diff-function-face ((t (:foreground "grey50")))) (diff-header-face ((t (:background "grey85")))) (diff-hunk-header-face ((t (:background "grey85")))) (diff-index-face ((t (:bold t :weight bold :background "grey70")))) (diff-nonexistent-face ((t (:bold t :weight bold :background "grey70")))) (diff-removed-face ((t (nil)))) (dired-face-boring ((t (:foreground "RosyBrown")))) (dired-face-directory ((t (:foreground "Blue")))) (dired-face-executable ((t (nil)))) (dired-face-flagged ((t (:foreground "Red" :weight bold)))) (dired-face-marked ((t (:foreground "Red" :weight bold)))) (dired-face-permissions ((t (nil)))) (dired-face-setuid ((t (nil)))) (dired-face-socket ((t (nil)))) (dired-face-symlink ((t (:foreground "Purple")))) (ebrowse-default-face ((t (nil)))) (ebrowse-file-name-face ((t (:italic t :slant italic)))) (ebrowse-member-attribute-face ((t (:foreground "red")))) (ebrowse-member-class-face ((t (:foreground "purple")))) (ebrowse-progress-face ((t (:background "blue")))) (ebrowse-root-class-face ((t (:bold t :foreground "blue" :weight bold)))) (ebrowse-tree-mark-face ((t (:foreground "red")))) (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) (eshell-ls-directory-face ((t (:bold t :foreground "Blue" :weight bold)))) (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) (eshell-ls-product-face ((t (:foreground "OrangeRed")))) (eshell-ls-readonly-face ((t (:foreground "Brown")))) (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan" :weight bold)))) (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) (eshell-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) (eshell-test-ok-face ((t (:bold t :foreground "Green" :weight bold)))) (excerpt ((t (:italic t :slant italic)))) (fixed ((t (:bold t :weight bold)))) (fixed-pitch ((t (:family "courier")))) (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) (font-lock-builtin-face ((t (:foreground "Orchid")))) (font-lock-comment-face ((t (:foreground "Firebrick")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-doc-face ((t (:foreground "RosyBrown")))) (font-lock-doc-string-face ((t (:foreground "RosyBrown")))) (font-lock-function-name-face ((t (:foreground "Blue")))) (font-lock-keyword-face ((t (:foreground "Purple")))) (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) (font-lock-reference-face ((t (:foreground "Orchid")))) (font-lock-string-face ((t (:foreground "RosyBrown")))) (font-lock-type-face ((t (:foreground "ForestGreen")))) (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) (fringe ((t (:background "grey95")))) (gnus-cite-attribution-face ((t (:italic t :slant italic)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t :weight bold)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t :slant italic)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3" :weight bold)))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3" :weight bold)))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4" :weight bold)))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4" :weight bold)))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4" :weight bold)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t :weight bold)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t :weight bold)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t :weight bold)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t :weight bold)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) (gnus-header-content-face ((t (:italic t :foreground "indianred4" :slant italic)))) (gnus-header-from-face ((t (:foreground "red3")))) (gnus-header-name-face ((t (:foreground "maroon")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue" :slant italic)))) (gnus-header-subject-face ((t (:foreground "red4")))) (gnus-signature-face ((t (:italic t :slant italic)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick" :weight bold)))) (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue" :slant italic)))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen" :slant italic)))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick" :slant italic)))) (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (header-line ((t (:box (:line-width -1 :style released-button) :background "grey90" :foreground "grey20" :box nil)))) (hi-black-b ((t (:bold t :weight bold)))) (hi-black-hb ((t (:bold t :family "helv" :weight bold :height 1.67)))) (hi-blue ((t (:background "light blue")))) (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) (hi-green ((t (:background "green")))) (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) (hi-pink ((t (:background "pink")))) (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) (hi-yellow ((t (:background "yellow")))) (highlight ((t (:background "darkseagreen2")))) (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) (highlight-changes-face ((t (:foreground "red")))) (holiday-face ((t (:background "pink")))) (idlwave-help-link-face ((t (:foreground "Blue")))) (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "brown")))) (info-header-xref ((t (:bold t :weight bold :foreground "magenta4")))) (info-menu-5 ((t (:foreground "red1")))) (info-menu-header ((t (:bold t :family "helv" :weight bold)))) (info-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) (info-xref ((t (:bold t :foreground "magenta4" :weight bold)))) (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) (italic ((t (:italic t :slant italic)))) (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) (log-view-message-face ((t (:background "grey85")))) (makefile-space-face ((t (:background "hotpink")))) (menu ((t (nil)))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue" :weight bold)))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue" :weight bold)))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (modeline-buffer-id ((t (:bold t :background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (modeline-mousable ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (mouse ((t (:background "black")))) (primary-selection ((t (:background "lightgoldenrod2")))) (reb-match-0 ((t (:background "lightblue")))) (reb-match-1 ((t (:background "aquamarine")))) (reb-match-2 ((t (:background "springgreen")))) (reb-match-3 ((t (:background "yellow")))) (region ((t (:background "lightgoldenrod2")))) (scroll-bar ((t (:background "grey75")))) (secondary-selection ((t (:background "yellow")))) (sh-heredoc-face ((t (:foreground "tan")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (show-tabs-space-face ((t (:foreground "yellow")))) (show-tabs-tab-face ((t (:foreground "red")))) (smerge-base-face ((t (:foreground "red")))) (smerge-markers-face ((t (:background "grey85")))) (smerge-mine-face ((t (:foreground "blue")))) (smerge-other-face ((t (:foreground "darkgreen")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-tag-face ((t (:foreground "brown")))) (strokes-char-face ((t (:background "lightgray")))) (term-black ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-blackbg ((t (:stipple nil :background "black" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-blue ((t (:stipple nil :background "white" :foreground "blue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-bluebg ((t (:stipple nil :background "blue" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-bold ((t (:bold t :stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :width normal :family "adobe-courier")))) (term-cyan ((t (:stipple nil :background "white" :foreground "cyan" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-cyanbg ((t (:stipple nil :background "cyan" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-bg ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-bg-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-fg ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-fg-inv ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-green ((t (:stipple nil :background "white" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-greenbg ((t (:stipple nil :background "green" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-invisible ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-invisible-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-magenta ((t (:stipple nil :background "white" :foreground "magenta" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-magentabg ((t (:stipple nil :background "magenta" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-red ((t (:stipple nil :background "white" :foreground "red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-redbg ((t (:stipple nil :background "red" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-underline ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline t :slant normal :weight normal :width normal :family "adobe-courier")))) (term-white ((t (:stipple nil :background "white" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-whitebg ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-yellow ((t (:stipple nil :background "white" :foreground "yellow" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-yellowbg ((t (:stipple nil :background "yellow" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (tex-math-face ((t (:foreground "RosyBrown")))) (texinfo-heading-face ((t (:foreground "Blue")))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange" :weight bold)))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-search-face ((t (:background "khaki" :foreground "Black")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85")))) (woman-addition-face ((t (:foreground "orange")))) (woman-bold-face ((t (:bold t :foreground "blue" :weight bold)))) (woman-italic-face ((t (:italic t :foreground "red" :underline t :slant italic)))) (woman-unknown-face ((t (:foreground "brown")))) (zmacs-region ((t (:background "lightgoldenrod2"))))))) (defun color-theme-jsc-light2 () "Color theme by John S Cooper, created 2001-10-29. This builds on `color-theme-jsc-light'." (interactive) (color-theme-jsc-light) (let ((color-theme-is-cumulative t)) (color-theme-install '(color-theme-jsc-light2 ((vc-annotate-very-old-color . "#0046FF") (senator-eldoc-use-color . t)) nil (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (change-log-file-face ((t (:foreground "Blue")))) (change-log-name-face ((t (:foreground "Maroon")))) (comint-highlight-prompt ((t (:foreground "dark blue")))) (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) (font-lock-constant-face ((t (:foreground "Maroon")))) (font-lock-function-name-face ((t (:foreground "Blue")))) (font-lock-type-face ((t (:italic t :foreground "Navy" :slant italic)))) (fringe ((t (:background "grey88")))) (gnus-group-mail-1-empty-face ((t (:foreground "Blue2")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) (gnus-header-content-face ((t (:italic t :foreground "indianred4" :slant italic)))) (gnus-header-name-face ((t (:bold t :foreground "maroon" :weight bold)))) (gnus-header-subject-face ((t (:foreground "red4")))) (gnus-signature-face ((t (:italic t :slant italic)))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "Navy")))) (gnus-summary-normal-unread-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) (header-line ((t (:background "grey90" :foreground "grey20" :box nil)))) (highlight ((t (:background "darkseagreen2")))) (ido-subdir-face ((t (:foreground "red")))) (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) (mode-line ((t (:background "grey88" :foreground "black" :box (:line-width -1 :style released-button))))) (region ((t (:background "lightgoldenrod2")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "yellow")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (tooltip ((t (:background "lightyellow" :foreground "black")))))))) (defun color-theme-ld-dark () "Dark Color theme by Linh Dang, created 2001-11-06." (interactive) (color-theme-install '(color-theme-ld-dark ((background-color . "black") (background-mode . dark) (border-color . "black") (cursor-color . "yellow") (foreground-color . "white") (mouse-color . "white")) ((align-highlight-change-face . highlight) (align-highlight-nochange-face . secondary-selection) (apropos-keybinding-face . underline) (apropos-label-face . italic) (apropos-match-face . secondary-selection) (apropos-property-face . bold-italic) (apropos-symbol-face . bold) (ebnf-except-border-color . "Black") (ebnf-line-color . "Black") (ebnf-non-terminal-border-color . "Black") (ebnf-repeat-border-color . "Black") (ebnf-special-border-color . "Black") (ebnf-terminal-border-color . "Black") (gnus-article-button-face . bold) (gnus-article-mouse-face . highlight) (gnus-carpal-button-face . bold) (gnus-carpal-header-face . bold-italic) (gnus-cite-attribution-face . gnus-cite-attribution-face) (gnus-mouse-face . highlight) (gnus-selected-tree-face . modeline) (gnus-signature-face . gnus-signature-face) (gnus-summary-selected-face . gnus-summary-selected-face) (help-highlight-face . underline) (list-matching-lines-face . bold) (ps-line-number-color . "black") (ps-zebra-color . 0.95) (tags-tag-face . default) (vc-annotate-very-old-color . "#0046FF") (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "black" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) (bbdb-company ((t (:italic t :slant italic)))) (bbdb-field-name ((t (:bold t :weight bold)))) (bbdb-field-value ((t (nil)))) (bbdb-name ((t (:underline t)))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (change-log-acknowledgement-face ((t (:italic t :slant oblique :foreground "AntiqueWhite3")))) (change-log-conditionals-face ((t (:foreground "Aquamarine")))) (change-log-date-face ((t (:italic t :slant oblique :foreground "BurlyWood")))) (change-log-email-face ((t (:foreground "Aquamarine")))) (change-log-file-face ((t (:bold t :family "Verdana" :weight bold :foreground "LightSkyBlue" :height 0.9)))) (change-log-function-face ((t (:foreground "Aquamarine")))) (change-log-list-face ((t (:foreground "LightSkyBlue")))) (change-log-name-face ((t (:bold t :weight bold :foreground "Gold")))) (clear-case-mode-string-face ((t (:bold t :family "Arial" :box (:line-width 2 :color "grey" :style released-button) :foreground "black" :background "grey" :weight bold :height 0.9)))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cursor ((t (:background "yellow")))) (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "dim gray")))) (custom-comment-tag-face ((t (:foreground "gray80")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.1)))) (custom-group-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.1)))) (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.1)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "lime green")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.2)))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-context-face ((t (:foreground "grey70")))) (diff-file-header-face ((t (:bold t :background "grey60" :weight bold)))) (diff-function-face ((t (:foreground "grey70")))) (diff-header-face ((t (:background "grey45")))) (diff-hunk-header-face ((t (:background "grey45")))) (diff-index-face ((t (:bold t :weight bold :background "grey60")))) (diff-nonexistent-face ((t (:bold t :weight bold :background "grey60")))) (diff-removed-face ((t (nil)))) (fixed-pitch ((t (:family "courier")))) (font-lock-builtin-face ((t (:foreground "SteelBlue")))) (font-lock-comment-face ((t (:italic t :foreground "AntiqueWhite3" :slant oblique)))) (font-lock-constant-face ((t (:bold t :foreground "Gold" :weight bold)))) (font-lock-doc-face ((t (:italic t :slant oblique :foreground "BurlyWood")))) (font-lock-doc-string-face ((t (:italic t :slant oblique :foreground "BurlyWood")))) (font-lock-function-name-face ((t (:bold t :foreground "LightSkyBlue" :weight bold :height 0.9 :family "Verdana")))) (font-lock-keyword-face ((t (:foreground "LightSkyBlue")))) (font-lock-preprocessor-face ((t (:bold t :foreground "Gold" :weight bold)))) (font-lock-reference-face ((t (:foreground "SteelBlue")))) (font-lock-string-face ((t (:italic t :foreground "BurlyWood" :slant oblique)))) (font-lock-type-face ((t (:bold t :foreground "PaleGreen" :weight bold :height 0.9 :family "Verdana")))) (font-lock-variable-name-face ((t (:foreground "Aquamarine")))) (font-lock-warning-face ((t (:bold t :foreground "chocolate" :weight bold)))) (fringe ((t (:family "outline-courier new" :width normal :weight normal :slant normal :underline nil :overline nil :strike-through nil :box nil :inverse-video nil :stipple nil :background "grey4" :foreground "Wheat")))) (gnus-cite-attribution-face ((t (:italic t :slant italic)))) (gnus-cite-face-1 ((t (:foreground "light blue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "light cyan")))) (gnus-cite-face-3 ((t (:foreground "light yellow")))) (gnus-cite-face-4 ((t (:foreground "light pink")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:foreground "beige")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t :weight bold)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t :slant italic)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t :weight bold)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t :weight bold)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t :weight bold)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t :weight bold)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) (gnus-header-content-face ((t (:italic t :foreground "forest green" :slant italic)))) (gnus-header-from-face ((t (:foreground "spring green")))) (gnus-header-name-face ((t (:foreground "SeaGreen")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic)))) (gnus-header-subject-face ((t (:foreground "SeaGreen3")))) (gnus-signature-face ((t (:italic t :slant italic)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (header-line ((t (:family "Arial" :background "grey20" :foreground "grey75" :box (:line-width 3 :color "grey20" :style released-button) :height 0.9)))) (highlight ((t (:background "darkolivegreen")))) (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "white")))) (info-header-xref ((t (:bold t :weight bold :foreground "cyan")))) (info-menu-5 ((t (:foreground "red1")))) (info-menu-header ((t (:bold t :family "helv" :weight bold)))) (info-node ((t (:italic t :bold t :foreground "white" :slant italic :weight bold)))) (info-xref ((t (:bold t :foreground "cyan" :weight bold)))) (isearch ((t (:background "palevioletred2")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:italic t :slant italic)))) (makefile-space-face ((t (:background "hotpink")))) (menu ((t (nil)))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "green4" :weight bold)))) (message-header-name-face ((t (:foreground "DarkGreen")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) (message-header-other-face ((t (:foreground "#b00000")))) (message-header-subject-face ((t (:foreground "green3")))) (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "blue3")))) (modeline ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) (modeline-mousable-minor-mode ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) (modeline-mousable ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) (modeline-buffer-id ((t (:background "grey" :foreground "black" :box (:line-width 2 :color "grey" :style released-button) :height 0.9 :family "Arial")))) (mouse ((t (:background "white")))) (primary-selection ((t (:background "DarkSlateGray")))) (region ((t (:background "DarkSlateGray")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "SkyBlue4")))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (trailing-whitespace ((t (:background "white")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray")))) (zmacs-region ((t (:background "DarkSlateGray"))))))) (defun color-theme-deep-blue () "Color theme by Tomas Cerha, created 2001-11-13." (interactive) (color-theme-install '(color-theme-deep-blue ((background-color . "#102e4e") (background-mode . dark) (border-color . "black") (cursor-color . "green") (foreground-color . "#eeeeee") (mouse-color . "white")) ((browse-kill-ring-separator-face . bold) (display-time-mail-face . mode-line) (help-highlight-face . underline) (list-matching-lines-face . secondary-selection) (vc-annotate-very-old-color . "#0046FF") (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "#102e4e" :foreground "#eeeeee" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "misc-fixed")))) (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (calendar-today-face ((t (:background "blue")))) (change-log-acknowledgement-face ((t (:italic t :slant italic :foreground "CadetBlue")))) (change-log-conditionals-face ((t (:foreground "SeaGreen2")))) (change-log-date-face ((t (:foreground "burlywood")))) (change-log-email-face ((t (:foreground "SeaGreen2")))) (change-log-file-face ((t (:bold t :weight bold :foreground "goldenrod")))) (change-log-function-face ((t (:foreground "SeaGreen2")))) (change-log-list-face ((t (:bold t :weight bold :foreground "DeepSkyBlue1")))) (change-log-name-face ((t (:foreground "gold")))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cursor ((t (:background "green" :foreground "black")))) (cvs-filename-face ((t (:foreground "lightblue")))) (cvs-handled-face ((t (:foreground "pink")))) (cvs-header-face ((t (:bold t :foreground "lightyellow" :weight bold)))) (cvs-marked-face ((t (:bold t :foreground "green" :weight bold)))) (cvs-msg-face ((t (:italic t :slant italic)))) (cvs-need-action-face ((t (:foreground "orange")))) (cvs-unknown-face ((t (:foreground "red")))) (diary-face ((t (:foreground "orange red")))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-context-face ((t (:foreground "grey70")))) (diff-file-header-face ((t (:bold t :background "grey60" :weight bold)))) (diff-function-face ((t (:foreground "grey70")))) (diff-header-face ((t (:background "grey45")))) (diff-hunk-header-face ((t (:background "grey45")))) (diff-index-face ((t (:bold t :weight bold :background "grey60")))) (diff-nonexistent-face ((t (:bold t :weight bold :background "grey60")))) (diff-removed-face ((t (nil)))) (fixed-pitch ((t (:family "fixed")))) (font-latex-bold-face ((t (:bold t :foreground "OliveDrab" :weight bold)))) (font-latex-italic-face ((t (:italic t :foreground "OliveDrab" :slant italic)))) (font-latex-math-face ((t (:foreground "burlywood")))) (font-latex-sedate-face ((t (:foreground "LightGray")))) (font-latex-string-face ((t (:foreground "LightSalmon")))) (font-latex-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) (font-lock-builtin-face ((t (:foreground "LightCoral")))) (font-lock-comment-face ((t (:italic t :foreground "CadetBlue" :slant italic)))) (font-lock-constant-face ((t (:foreground "gold")))) (font-lock-doc-face ((t (:foreground "BlanchedAlmond")))) (font-lock-doc-string-face ((t (:foreground "BlanchedAlmond")))) (font-lock-function-name-face ((t (:bold t :foreground "goldenrod" :weight bold)))) (font-lock-keyword-face ((t (:bold t :foreground "DeepSkyBlue1" :weight bold)))) (font-lock-preprocessor-face ((t (:foreground "gold")))) (font-lock-reference-face ((t (:foreground "LightCoral")))) (font-lock-string-face ((t (:foreground "burlywood")))) (font-lock-type-face ((t (:foreground "CadetBlue1")))) (font-lock-variable-name-face ((t (:foreground "SeaGreen2")))) (font-lock-warning-face ((t (:foreground "yellow")))) (fringe ((t (:background "#405060")))) (header-line ((t (:box (:line-width 2 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) (highlight ((t (:background "darkgreen")))) (holiday-face ((t (:foreground "green")))) (info-header-node ((t (:foreground "DeepSkyBlue1")))) (info-header-xref ((t (:bold t :weight bold :foreground "SeaGreen2")))) (info-menu-5 ((t (:foreground "wheat")))) (info-menu-header ((t (:bold t :family "helv" :weight bold)))) (info-node ((t (:foreground "DeepSkyBlue1")))) (info-xref ((t (:bold t :foreground "SeaGreen2" :weight bold)))) (isearch ((t (:background "palevioletred2" :foreground "brown4")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:italic t :slant italic)))) (menu ((t (:background "gray" :foreground "black" :family "helvetica")))) (modeline ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) (modeline-buffer-id ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) (modeline-mousable ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) (modeline-mousable-minor-mode ((t (:background "gray" :foreground "black" :box (:line-width 2 :style released-button))))) (mouse ((t (:background "white")))) (region ((t (:background "DarkCyan")))) (scroll-bar ((t (:background "gray" :foreground "#506070")))) (secondary-selection ((t (:background "yellow" :foreground "gray10")))) (show-paren-match-face ((t (:bold t :foreground "yellow" :weight bold)))) (show-paren-mismatch-face ((t (:bold t :foreground "red" :weight bold)))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "#102e4e")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray"))))))) (defun color-theme-kingsajz () "Color theme by Olgierd \"Kingsajz\" Ziolko, created 2001-12-04. Another theme with wheat on DarkSlatGrey. Based on Subtle Hacker. Used on Emacs 21.1 @ WinMe. Not tested on any other systems. Some faces uses Andale mono font (nice fixed-width font). It is available at: http://www.microsoft.com/typography/downloads/andale32.exe Hail Eris! All hail Discordia!" (interactive) (color-theme-install '(color-theme-kingsajz ((background-color . "darkslategrey") (background-mode . dark) (border-color . "black") (cursor-color . "LightGray") (foreground-color . "wheat") (mouse-color . "Grey")) ((apropos-keybinding-face . underline) (apropos-label-face face italic mouse-face highlight) (apropos-match-face . secondary-selection) (apropos-property-face . bold-italic) (apropos-symbol-face . info-xref) (display-time-mail-face . mode-line) (gnus-article-button-face . bold) (gnus-article-mouse-face . highlight) (gnus-carpal-button-face . bold) (gnus-carpal-header-face . bold-italic) (gnus-cite-attribution-face . gnus-cite-attribution-face) (gnus-mouse-face . highlight) (gnus-selected-tree-face . modeline) (gnus-signature-face . gnus-signature-face) (gnus-summary-selected-face . gnus-summary-selected-face) (gnus-treat-display-xface . head) (help-highlight-face . underline) (list-matching-lines-face . bold) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "darkslategrey" :foreground "wheat" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono")))) (bbdb-field-name ((t (:foreground "green")))) (bg:erc-color-face0 ((t (:background "White")))) (bg:erc-color-face1 ((t (:background "black")))) (bg:erc-color-face10 ((t (:background "lightblue1")))) (bg:erc-color-face11 ((t (:background "cyan")))) (bg:erc-color-face12 ((t (:background "blue")))) (bg:erc-color-face13 ((t (:background "deeppink")))) (bg:erc-color-face14 ((t (:background "gray50")))) (bg:erc-color-face15 ((t (:background "gray90")))) (bg:erc-color-face2 ((t (:background "blue4")))) (bg:erc-color-face3 ((t (:background "green4")))) (bg:erc-color-face4 ((t (:background "red")))) (bg:erc-color-face5 ((t (:background "brown")))) (bg:erc-color-face6 ((t (:background "purple")))) (bg:erc-color-face7 ((t (:background "orange")))) (bg:erc-color-face8 ((t (:background "yellow")))) (bg:erc-color-face9 ((t (:background "green")))) (blue ((t (:foreground "cyan")))) (bold ((t (:bold t :foreground "OrangeRed" :weight bold :family "Arial")))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold :family "Arial")))) (border ((t (:background "black")))) (calendar-today-face ((t (:underline t)))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cperl-array-face ((t (:foreground "Yellow")))) (cperl-hash-face ((t (:foreground "White")))) (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) (cursor ((t (:background "LightGray")))) (custom-button-face ((t (:foreground "MediumSlateBlue" :underline t)))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "dim gray")))) (custom-comment-tag-face ((t (:foreground "gray80")))) (custom-documentation-face ((t (:foreground "Grey")))) (custom-face-tag-face ((t (:bold t :family "Arial" :weight bold :height 1.2)))) (custom-group-tag-face ((t (:foreground "MediumAquamarine")))) (custom-group-tag-face-1 ((t (:bold t :family "Arial" :foreground "pink" :weight bold :height 1.2)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "Coral")))) (custom-variable-button-face ((t (:underline t)))) (custom-variable-tag-face ((t (:foreground "Aquamarine")))) (date ((t (:foreground "green")))) (diary-face ((t (:bold t :foreground "IndianRed" :weight bold)))) (dired-face-directory ((t (:bold t :foreground "sky blue" :weight bold)))) (dired-face-executable ((t (:foreground "green yellow")))) (dired-face-flagged ((t (:foreground "tomato")))) (dired-face-marked ((t (:foreground "light salmon")))) (dired-face-permissions ((t (:foreground "aquamarine")))) (erc-action-face ((t (:bold t :weight bold)))) (erc-bold-face ((t (:bold t :weight bold)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "pale green")))) (erc-error-face ((t (:bold t :foreground "IndianRed" :weight bold)))) (erc-highlight-face ((t (:bold t :foreground "pale green" :weight bold)))) (erc-host-danger-face ((t (:foreground "red")))) (erc-input-face ((t (:foreground "light blue")))) (erc-inverse-face ((t (:background "steel blue")))) (erc-notice-face ((t (:foreground "light salmon")))) (erc-pal-face ((t (:foreground "pale green")))) (erc-prompt-face ((t (:bold t :foreground "light blue" :weight bold)))) (erc-underline-face ((t (:underline t)))) (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed" :weight bold)))) (eshell-ls-backup-face ((t (:foreground "Grey")))) (eshell-ls-clutter-face ((t (:bold t :foreground "DimGray" :weight bold)))) (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue" :weight bold)))) (eshell-ls-executable-face ((t (:bold t :foreground "Coral" :weight bold)))) (eshell-ls-missing-face ((t (:bold t :foreground "black" :weight bold)))) (eshell-ls-picture-face ((t (:foreground "Violet")))) (eshell-ls-product-face ((t (:foreground "LightSalmon")))) (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) (eshell-ls-special-face ((t (:bold t :foreground "Gold" :weight bold)))) (eshell-ls-symlink-face ((t (:bold t :foreground "White" :weight bold)))) (eshell-ls-text-face ((t (:foreground "medium aquamarine")))) (eshell-ls-todo-face ((t (:bold t :foreground "aquamarine" :weight bold)))) (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) (eshell-prompt-face ((t (:foreground "powder blue")))) (face-1 ((t (:stipple nil :foreground "royal blue" :family "andale mono")))) (face-2 ((t (:stipple nil :foreground "DeepSkyBlue1" :overline nil :underline nil :slant normal :family "outline-andale mono")))) (face-3 ((t (:stipple nil :foreground "NavajoWhite3")))) (fg:erc-color-face0 ((t (:foreground "white")))) (fg:erc-color-face1 ((t (:foreground "beige")))) (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) (fg:erc-color-face12 ((t (:foreground "light yellow")))) (fg:erc-color-face13 ((t (:foreground "yellow")))) (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) (fg:erc-color-face15 ((t (:foreground "lime green")))) (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) (fg:erc-color-face3 ((t (:foreground "light cyan")))) (fg:erc-color-face4 ((t (:foreground "powder blue")))) (fg:erc-color-face5 ((t (:foreground "sky blue")))) (fg:erc-color-face6 ((t (:foreground "dark sea green")))) (fg:erc-color-face7 ((t (:foreground "pale green")))) (fg:erc-color-face8 ((t (:foreground "medium spring green")))) (fg:erc-color-face9 ((t (:foreground "khaki")))) (fixed-pitch ((t (:family "courier")))) (font-lock-builtin-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) (font-lock-comment-face ((t (:foreground "White")))) (font-lock-constant-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) (font-lock-doc-face ((t (:italic t :slant italic :foreground "LightSalmon")))) (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) (font-lock-function-name-face ((t (:bold t :foreground "MediumSlateBlue" :weight bold)))) (font-lock-keyword-face ((t (:foreground "Salmon")))) (font-lock-preprocessor-face ((t (:foreground "Salmon")))) (font-lock-reference-face ((t (:foreground "pale green")))) (font-lock-string-face ((t (:italic t :foreground "LightSalmon" :slant italic)))) (font-lock-type-face ((t (:bold t :foreground "YellowGreen" :weight bold)))) (font-lock-variable-name-face ((t (:italic t :bold t :foreground "Aquamarine" :slant italic :weight bold)))) (font-lock-warning-face ((t (:bold t :foreground "IndianRed" :weight bold)))) (fringe ((t (:background "darkslategrey")))) (gnus-cite-attribution-face ((t (:family "arial")))) (gnus-cite-face-1 ((t (:foreground "DarkGoldenrod3")))) (gnus-cite-face-10 ((t (nil)))) (gnus-cite-face-11 ((t (nil)))) (gnus-cite-face-2 ((t (:foreground "IndianRed3")))) (gnus-cite-face-3 ((t (:foreground "tomato")))) (gnus-cite-face-4 ((t (:foreground "yellow green")))) (gnus-cite-face-5 ((t (:foreground "SteelBlue3")))) (gnus-cite-face-6 ((t (:foreground "Azure3")))) (gnus-cite-face-7 ((t (:foreground "Azure4")))) (gnus-cite-face-8 ((t (:foreground "SpringGreen4")))) (gnus-cite-face-9 ((t (:foreground "SlateGray4")))) (gnus-emphasis-bold ((t (:bold t :foreground "greenyellow" :weight bold :family "Arial")))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "OrangeRed1" :slant italic :weight bold :family "arial")))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "khaki")))) (gnus-emphasis-italic ((t (:italic t :bold t :foreground "orange" :slant italic :weight bold :family "Arial")))) (gnus-emphasis-underline ((t (:foreground "greenyellow" :underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :foreground "khaki" :underline t :weight bold :family "Arial")))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold :family "Arial")))) (gnus-emphasis-underline-italic ((t (:italic t :foreground "orange" :underline t :slant italic :family "Arial")))) (gnus-group-mail-1-empty-face ((t (:foreground "Salmon4")))) (gnus-group-mail-1-face ((t (:bold t :foreground "firebrick1" :weight bold)))) (gnus-group-mail-2-empty-face ((t (:foreground "turquoise4")))) (gnus-group-mail-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) (gnus-group-mail-3-empty-face ((t (:foreground "LightCyan4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "LightCyan1" :weight bold)))) (gnus-group-mail-low-empty-face ((t (:foreground "SteelBlue4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "SteelBlue2" :weight bold)))) (gnus-group-news-1-empty-face ((t (:foreground "Salmon4")))) (gnus-group-news-1-face ((t (:bold t :foreground "FireBrick1" :weight bold)))) (gnus-group-news-2-empty-face ((t (:foreground "darkorange3")))) (gnus-group-news-2-face ((t (:bold t :foreground "dark orange" :weight bold)))) (gnus-group-news-3-empty-face ((t (:foreground "turquoise4")))) (gnus-group-news-3-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) (gnus-group-news-4-empty-face ((t (:foreground "SpringGreen4")))) (gnus-group-news-4-face ((t (:bold t :foreground "SpringGreen2" :weight bold)))) (gnus-group-news-5-empty-face ((t (:foreground "OliveDrab4")))) (gnus-group-news-5-face ((t (:bold t :foreground "OliveDrab2" :weight bold)))) (gnus-group-news-6-empty-face ((t (:foreground "DarkGoldenrod4")))) (gnus-group-news-6-face ((t (:bold t :foreground "DarkGoldenrod3" :weight bold)))) (gnus-group-news-low-empty-face ((t (:foreground "wheat4")))) (gnus-group-news-low-face ((t (:bold t :foreground "tan4" :weight bold)))) (gnus-header-content-face ((t (:foreground "LightSkyBlue3")))) (gnus-header-from-face ((t (:bold t :foreground "light cyan" :weight bold)))) (gnus-header-name-face ((t (:bold t :foreground "DodgerBlue1" :weight bold)))) (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3" :slant italic :weight bold)))) (gnus-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) (gnus-signature-face ((t (:italic t :foreground "salmon" :slant italic)))) (gnus-splash-face ((t (:foreground "Firebrick1")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "MistyRose4" :weight bold)))) (gnus-summary-high-read-face ((t (:bold t :foreground "tomato3" :weight bold)))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "coral" :weight bold)))) (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "red1" :slant italic :weight bold)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "DarkSeaGreen4" :slant italic)))) (gnus-summary-low-read-face ((t (:foreground "SeaGreen4")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "Green4" :slant italic)))) (gnus-summary-low-unread-face ((t (:italic t :foreground "green3" :slant italic)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "khaki4")))) (gnus-summary-normal-ticked-face ((t (:foreground "khaki3")))) (gnus-summary-normal-unread-face ((t (:foreground "khaki")))) (gnus-summary-selected-face ((t (:foreground "gold" :underline t)))) (green ((t (:foreground "green")))) (gui-button-face ((t (:foreground "red" :background "black")))) (gui-element ((t (:bold t :background "#ffffff" :foreground "#000000" :weight bold)))) (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) (highlight ((t (:background "PaleGreen" :foreground "DarkGreen")))) (highline-face ((t (:background "SeaGreen")))) (holiday-face ((t (:background "DimGray")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:bold t :foreground "DodgerBlue1" :underline t :weight bold)))) (info-xref ((t (:bold t :foreground "DodgerBlue3" :weight bold)))) (isearch ((t (:background "sea green" :foreground "black")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:italic t :foreground "chocolate3" :slant italic)))) (menu ((t (nil)))) (message-cited-text-face ((t (:foreground "White")))) (message-header-cc-face ((t (:foreground "light cyan")))) (message-header-name-face ((t (:foreground "DodgerBlue1")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3" :slant italic :weight bold)))) (message-header-other-face ((t (:foreground "LightSkyBlue3")))) (message-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) (message-header-to-face ((t (:bold t :foreground "light cyan" :weight bold)))) (message-header-xheader-face ((t (:foreground "DodgerBlue3")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:background "cornflower blue" :foreground "chocolate")))) (modeline ((t (:background "dark olive green" :foreground "wheat" :box (:line-width -1 :style released-button))))) (modeline-buffer-id ((t (:bold t :background "dark olive green" :foreground "beige" :weight bold :family "arial")))) (modeline-mousable ((t (:bold t :background "dark olive green" :foreground "yellow green" :weight bold :family "arial")))) (modeline-mousable-minor-mode ((t (:bold t :background "dark olive green" :foreground "wheat" :weight bold :family "arial")))) (mouse ((t (:background "Grey")))) (paren-blink-off ((t (:foreground "brown")))) (region ((t (:background "dark cyan" :foreground "cyan")))) (ruler-mode-column-number-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :foreground "black")))) (ruler-mode-current-column-face ((t (:bold t :box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :width normal :family "outline-andale mono" :foreground "yellow" :weight bold)))) (ruler-mode-default-face ((t (:family "outline-andale mono" :width normal :weight normal :slant normal :underline nil :overline nil :strike-through nil :inverse-video nil :stipple nil :background "grey76" :foreground "grey64" :box (:color "grey76" :line-width 1 :style released-button))))) (ruler-mode-fill-column-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :foreground "red")))) (ruler-mode-margins-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :foreground "grey64" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :background "grey64")))) (ruler-mode-tab-stop-face ((t (:box (:color "grey76" :line-width 1 :style released-button) :background "grey76" :stipple nil :inverse-video nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-andale mono" :foreground "steelblue")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) (show-paren-match-face ((t (:bold t :background "Aquamarine" :foreground "steel blue" :weight bold)))) (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) (swbuff-current-buffer-face ((t (:bold t :foreground "red" :weight bold)))) (text-cursor ((t (:background "Red" :foreground "white")))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "Arial")))) (w3m-anchor-face ((t (:bold t :foreground "DodgerBlue1" :weight bold)))) (w3m-arrived-anchor-face ((t (:bold t :foreground "DodgerBlue3" :weight bold)))) (w3m-header-line-location-content-face ((t (:background "dark olive green" :foreground "wheat")))) (w3m-header-line-location-title-face ((t (:background "dark olive green" :foreground "beige")))) (widget-button-face ((t (:bold t :foreground "green" :weight bold :family "courier")))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:foreground "LightBlue")))) (widget-inactive-face ((t (:foreground "DimGray")))) (widget-single-line-field-face ((t (:foreground "LightBlue")))) (woman-bold-face ((t (:bold t :weight bold :family "Arial")))) (woman-italic-face ((t (:italic t :foreground "beige" :slant italic :family "Arial")))) (woman-unknown-face ((t (:foreground "LightSalmon")))) (zmacs-region ((t (:background "dark cyan" :foreground "cyan"))))))) (defun color-theme-comidia () "Color theme by Marcelo Dias de Toledo, created 2001-12-17. Steel blue on black." (interactive) (color-theme-install '(color-theme-comidia ((background-color . "Black") (background-mode . dark) (border-color . "black") (cursor-color . "SteelBlue") (foreground-color . "SteelBlue") (mouse-color . "SteelBlue")) ((display-time-mail-face . mode-line) (gnus-mouse-face . highlight) (gnus-summary-selected-face . gnus-summary-selected-face) (help-highlight-face . underline) (ispell-highlight-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "Black" :foreground "SteelBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width semi-condensed :family "misc-fixed")))) (bg:erc-color-face0 ((t (:background "White")))) (bg:erc-color-face1 ((t (:background "black")))) (bg:erc-color-face10 ((t (:background "lightblue1")))) (bg:erc-color-face11 ((t (:background "cyan")))) (bg:erc-color-face12 ((t (:background "blue")))) (bg:erc-color-face13 ((t (:background "deeppink")))) (bg:erc-color-face14 ((t (:background "gray50")))) (bg:erc-color-face15 ((t (:background "gray90")))) (bg:erc-color-face2 ((t (:background "blue4")))) (bg:erc-color-face3 ((t (:background "green4")))) (bg:erc-color-face4 ((t (:background "red")))) (bg:erc-color-face5 ((t (:background "brown")))) (bg:erc-color-face6 ((t (:background "purple")))) (bg:erc-color-face7 ((t (:background "orange")))) (bg:erc-color-face8 ((t (:background "yellow")))) (bg:erc-color-face9 ((t (:background "green")))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cursor ((t (:background "SteelBlue")))) (erc-action-face ((t (:bold t :weight bold)))) (erc-bold-face ((t (:bold t :weight bold)))) (erc-dangerous-host-face ((t (:foreground "red")))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "IndianRed")))) (erc-error-face ((t (:background "Red" :foreground "White")))) (erc-fool-face ((t (:foreground "dim gray")))) (erc-input-face ((t (:foreground "brown")))) (erc-inverse-face ((t (:background "Black" :foreground "White")))) (erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold)))) (erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold)))) (erc-pal-face ((t (:bold t :foreground "Magenta" :weight bold)))) (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight bold)))) (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) (erc-underline-face ((t (:underline t)))) (fg:erc-color-face0 ((t (:foreground "White")))) (fg:erc-color-face1 ((t (:foreground "black")))) (fg:erc-color-face10 ((t (:foreground "lightblue1")))) (fg:erc-color-face11 ((t (:foreground "cyan")))) (fg:erc-color-face12 ((t (:foreground "blue")))) (fg:erc-color-face13 ((t (:foreground "deeppink")))) (fg:erc-color-face14 ((t (:foreground "gray50")))) (fg:erc-color-face15 ((t (:foreground "gray90")))) (fg:erc-color-face2 ((t (:foreground "blue4")))) (fg:erc-color-face3 ((t (:foreground "green4")))) (fg:erc-color-face4 ((t (:foreground "red")))) (fg:erc-color-face5 ((t (:foreground "brown")))) (fg:erc-color-face6 ((t (:foreground "purple")))) (fg:erc-color-face7 ((t (:foreground "orange")))) (fg:erc-color-face8 ((t (:foreground "yellow")))) (fg:erc-color-face9 ((t (:foreground "green")))) (fixed-pitch ((t (:family "courier")))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:foreground "chocolate1")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-doc-face ((t (:foreground "LightSalmon")))) (font-lock-doc-string-face ((t (:foreground "LightSalmon")))) (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) (font-lock-keyword-face ((t (:foreground "Cyan")))) (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) (font-lock-reference-face ((t (:foreground "LightSteelBlue")))) (font-lock-string-face ((t (:foreground "LightSalmon")))) (font-lock-type-face ((t (:foreground "PaleGreen")))) (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) (fringe ((t (:background "grey10")))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t :weight bold)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t :weight bold)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t :weight bold)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t :weight bold)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (header-line ((t (:family "neep" :width condensed :box (:line-width 1 :style none) :background "grey20" :foreground "grey90" :box nil)))) (highlight ((t (:background "darkolivegreen")))) (isearch ((t (:background "palevioletred2" :foreground "brown4")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:italic t :slant italic)))) (menu ((t (nil)))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "green4" :weight bold)))) (message-header-name-face ((t (:foreground "DarkGreen")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) (message-header-other-face ((t (:foreground "#b00000")))) (message-header-subject-face ((t (:foreground "green3")))) (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "blue3")))) (modeline ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) (modeline-buffer-id ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) (modeline-mousable-minor-mode ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) (modeline-mousable ((t (:background "Gray10" :foreground "SteelBlue" :box (:line-width 1 :style none) :width condensed :family "neep")))) (mouse ((t (:background "SteelBlue")))) (primary-selection ((t (:background "blue3")))) (region ((t (:background "blue3")))) (scroll-bar ((t (:background "grey75")))) (secondary-selection ((t (:background "SkyBlue4")))) (speedbar-button-face ((t (:foreground "green3")))) (speedbar-directory-face ((t (:foreground "light blue")))) (speedbar-file-face ((t (:foreground "cyan")))) (speedbar-highlight-face ((t (:background "sea green")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-tag-face ((t (:foreground "yellow")))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray")))) (zmacs-region ((t (:background "blue3"))))))) (defun color-theme-katester () "Color theme by walterh@rocketmail.com, created 2001-12-12. A pastelly-mac like color-theme." (interactive) (color-theme-standard) (let ((color-theme-is-cumulative t)) (color-theme-install '(color-theme-katester ((background-color . "ivory") (cursor-color . "slateblue") (foreground-color . "black") (mouse-color . "slateblue")) (default ((t ((:background "ivory" :foreground "black"))))) (bold ((t (:bold t)))) (font-lock-string-face ((t (:foreground "maroon")))) (font-lock-keyword-face ((t (:foreground "blue")))) (font-lock-constant-face ((t (:foreground "darkblue")))) (font-lock-type-face ((t (:foreground "black")))) (font-lock-variable-name-face ((t (:foreground "black")))) (font-lock-function-name-face ((t (:bold t :underline t)))) (font-lock-comment-face ((t (:background "seashell")))) (highlight ((t (:background "lavender")))) (italic ((t (:italic t)))) (modeline ((t (:background "moccasin" :foreground "black")))) (region ((t (:background "lavender" )))) (underline ((t (:underline t)))))))) (defun color-theme-arjen () "Color theme by awiersma, created 2001-08-27." (interactive) (color-theme-install '(color-theme-arjen ((background-color . "black") (background-mode . dark) (border-color . "black") (cursor-color . "yellow") (foreground-color . "White") (mouse-color . "sienna1")) ((buffers-tab-face . buffers-tab) (cperl-here-face . font-lock-string-face) (cperl-invalid-face quote underline) (cperl-pod-face . font-lock-comment-face) (cperl-pod-head-face . font-lock-variable-name-face) (vc-mode-face . highlight)) (default ((t (:background "black" :foreground "white")))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:bold t)))) (border-glyph ((t (nil)))) (buffers-tab ((t (:background "black" :foreground "white")))) (calendar-today-face ((t (:underline t)))) (cperl-array-face ((t (:foreground "darkseagreen")))) (cperl-hash-face ((t (:foreground "darkseagreen")))) (cperl-nonoverridable-face ((t (:foreground "SkyBlue")))) (custom-button-face ((t (nil)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "light blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "pink")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "lime green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "light blue")))) (diary-face ((t (:foreground "IndianRed")))) (erc-action-face ((t (:bold t)))) (erc-bold-face ((t (:bold t)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "sandybrown")))) (erc-error-face ((t (:bold t :foreground "IndianRed")))) (erc-input-face ((t (:foreground "Beige")))) (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) (erc-notice-face ((t (:foreground "MediumAquamarine")))) (erc-pal-face ((t (:foreground "pale green")))) (erc-prompt-face ((t (:foreground "MediumAquamarine")))) (erc-underline-face ((t (:underline t)))) (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) (eshell-ls-backup-face ((t (:foreground "Grey")))) (eshell-ls-clutter-face ((t (:foreground "DimGray")))) (eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue")))) (eshell-ls-executable-face ((t (:foreground "Coral")))) (eshell-ls-missing-face ((t (:foreground "black")))) (eshell-ls-picture-face ((t (:foreground "Violet")))) (eshell-ls-product-face ((t (:foreground "sandybrown")))) (eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) (eshell-ls-special-face ((t (:foreground "Gold")))) (eshell-ls-symlink-face ((t (:foreground "White")))) (eshell-ls-unreadable-face ((t (:foreground "DimGray")))) (eshell-prompt-face ((t (:foreground "MediumAquamarine")))) (fl-comment-face ((t (:foreground "pink")))) (fl-doc-string-face ((t (:foreground "purple")))) (fl-function-name-face ((t (:foreground "red")))) (fl-keyword-face ((t (:foreground "cadetblue")))) (fl-string-face ((t (:foreground "green")))) (fl-type-face ((t (:foreground "yellow")))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:foreground "IndianRed")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-doc-string-face ((t (:foreground "DarkOrange")))) (font-lock-function-name-face ((t (:foreground "YellowGreen")))) (font-lock-keyword-face ((t (:foreground "PaleYellow")))) (font-lock-preprocessor-face ((t (:foreground "Aquamarine")))) (font-lock-reference-face ((t (:foreground "SlateBlue")))) (font-lock-string-face ((t (:foreground "Orange")))) (font-lock-type-face ((t (:foreground "Green")))) (font-lock-variable-name-face ((t (:foreground "darkseagreen")))) (font-lock-warning-face ((t (:bold t :foreground "Pink")))) (qt-classes-face ((t (:foreground "Red")))) (gnus-cite-attribution-face ((t (nil)))) (gnus-cite-face-1 ((t (:bold nil :foreground "deep sky blue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:bold nil :foreground "cadetblue")))) (gnus-cite-face-3 ((t (:bold nil :foreground "gold")))) (gnus-cite-face-4 ((t (:foreground "light pink")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:bold nil :foreground "chocolate")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold nil)))) (gnus-emphasis-bold-italic ((t (:bold nil)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (nil)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold nil)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :bold nil)))) (gnus-emphasis-underline-italic ((t (:underline t)))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-1-face ((t (:bold nil :foreground "aquamarine1")))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold nil :foreground "aquamarine2")))) (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) (gnus-group-mail-3-face ((t (:bold nil :foreground "aquamarine3")))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-group-mail-low-face ((t (:bold nil :foreground "aquamarine4")))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold nil :foreground "PaleTurquoise")))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold nil :foreground "turquoise")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold nil)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold nil)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold nil)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold nil)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold nil :foreground "DarkTurquoise")))) (gnus-header-content-face ((t (:foreground "forest green")))) (gnus-header-from-face ((t (:bold nil :foreground "spring green")))) (gnus-header-name-face ((t (:foreground "deep sky blue")))) (gnus-header-newsgroups-face ((t (:bold nil :foreground "purple")))) (gnus-header-subject-face ((t (:bold nil :foreground "orange")))) (gnus-signature-face ((t (:bold nil :foreground "khaki")))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold nil :foreground "SkyBlue")))) (gnus-summary-high-read-face ((t (:bold nil :foreground "PaleGreen")))) (gnus-summary-high-ticked-face ((t (:bold nil :foreground "pink")))) (gnus-summary-high-unread-face ((t (:bold nil)))) (gnus-summary-low-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-low-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-low-ticked-face ((t (:foreground "pink")))) (gnus-summary-low-unread-face ((t (nil)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (:background "#D4D0C8" :foreground "black")))) (highlight ((t (:background "darkolivegreen")))) (highline-face ((t (:background "SeaGreen")))) (holiday-face ((t (:background "DimGray")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:underline t :bold t :foreground "DodgerBlue1")))) (info-xref ((t (:underline t :foreground "DodgerBlue1")))) (isearch ((t (:background "blue")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (nil)))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68" :foreground "white")))) (message-cited-text-face ((t (:bold t :foreground "green")))) (message-header-cc-face ((t (:bold t :foreground "green4")))) (message-header-name-face ((t (:bold t :foreground "orange")))) (message-header-newsgroups-face ((t (:bold t :foreground "violet")))) (message-header-other-face ((t (:bold t :foreground "chocolate")))) (message-header-subject-face ((t (:bold t :foreground "yellow")))) (message-header-to-face ((t (:bold t :foreground "cadetblue")))) (message-header-xheader-face ((t (:bold t :foreground "light blue")))) (message-mml-face ((t (:bold t :foreground "Green3")))) (message-separator-face ((t (:foreground "blue3")))) (modeline ((t (:background "DarkRed" :foreground "white" :box (:line-width 1 :style released-button))))) (modeline-buffer-id ((t (:background "DarkRed" :foreground "white")))) (modeline-mousable ((t (:background "DarkRed" :foreground "white")))) (modeline-mousable-minor-mode ((t (:background "DarkRed" :foreground "white")))) (p4-depot-added-face ((t (:foreground "blue")))) (p4-depot-deleted-face ((t (:foreground "red")))) (p4-depot-unmapped-face ((t (:foreground "grey30")))) (p4-diff-change-face ((t (:foreground "dark green")))) (p4-diff-del-face ((t (:foreground "red")))) (p4-diff-file-face ((t (:background "gray90")))) (p4-diff-head-face ((t (:background "gray95")))) (p4-diff-ins-face ((t (:foreground "blue")))) (pointer ((t (nil)))) (primary-selection ((t (:background "blue")))) (red ((t (:foreground "red")))) (region ((t (:background "blue")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "darkslateblue")))) (show-paren-match-face ((t (:background "Aquamarine" :foreground "SlateBlue")))) (show-paren-mismatch-face ((t (:background "Red" :foreground "White")))) (text-cursor ((t (:background "yellow" :foreground "black")))) (toolbar ((t (nil)))) (underline ((nil (:underline nil)))) (vertical-divider ((t (nil)))) (widget ((t (nil)))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray")))) (woman-bold-face ((t (:bold t)))) (woman-italic-face ((t (:foreground "beige")))) (woman-unknown-face ((t (:foreground "LightSalmon")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "snow" :foreground "blue"))))))) (defun color-theme-tty-dark () "Color theme by Oivvio Polite, created 2002-02-01. Good for tty display." (interactive) (color-theme-install '(color-theme-tty-dark ((background-color . "black") (background-mode . dark) (border-color . "blue") (cursor-color . "red") (foreground-color . "white") (mouse-color . "black")) ((ispell-highlight-face . highlight) (list-matching-lines-face . bold) (tinyreplace-:face . highlight) (view-highlight-face . highlight)) (default ((t (nil)))) (bold ((t (:underline t :background "black" :foreground "white")))) (bold-italic ((t (:underline t :foreground "white")))) (calendar-today-face ((t (:underline t)))) (diary-face ((t (:foreground "red")))) (font-lock-builtin-face ((t (:foreground "blue")))) (font-lock-comment-face ((t (:foreground "cyan")))) (font-lock-constant-face ((t (:foreground "magenta")))) (font-lock-function-name-face ((t (:foreground "cyan")))) (font-lock-keyword-face ((t (:foreground "red")))) (font-lock-string-face ((t (:foreground "green")))) (font-lock-type-face ((t (:foreground "yellow")))) (font-lock-variable-name-face ((t (:foreground "blue")))) (font-lock-warning-face ((t (:bold t :foreground "magenta")))) (highlight ((t (:background "blue" :foreground "yellow")))) (holiday-face ((t (:background "cyan")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:italic t :bold t)))) (info-xref ((t (:bold t)))) (italic ((t (:underline t :background "red")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "green")))) (message-header-name-face ((t (:foreground "green")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow")))) (message-header-other-face ((t (:foreground "#b00000")))) (message-header-subject-face ((t (:foreground "green")))) (message-header-to-face ((t (:bold t :foreground "green")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "green")))) (message-separator-face ((t (:foreground "blue")))) (modeline ((t (:background "white" :foreground "blue")))) (modeline-buffer-id ((t (:background "white" :foreground "red")))) (modeline-mousable ((t (:background "white" :foreground "magenta")))) (modeline-mousable-minor-mode ((t (:background "white" :foreground "yellow")))) (region ((t (:background "white" :foreground "black")))) (zmacs-region ((t (:background "cyan" :foreground "black")))) (secondary-selection ((t (:background "blue")))) (show-paren-match-face ((t (:background "red")))) (show-paren-mismatch-face ((t (:background "magenta" :foreground "white")))) (underline ((t (:underline t))))))) (defun color-theme-aliceblue () "Color theme by Girish Bharadwaj, created 2002-03-27. Includes comint prompt, custom, font-lock, isearch, jde, senator, speedbar, and widget." (interactive) (color-theme-install '(color-theme-aliceblue ((background-color . "AliceBlue") (background-mode . light) (border-color . "black") (cursor-color . "black") (foreground-color . "DarkSlateGray4") (mouse-color . "black")) ((help-highlight-face . underline) (list-matching-lines-face . bold) (semantic-which-function-use-color . t) (senator-eldoc-use-color . t) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "AliceBlue" :foreground "DarkSlateGray4" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "dark blue")))) (cursor ((t (:background "black")))) (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "gray85")))) (custom-comment-tag-face ((t (:foreground "blue4")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) (fixed-pitch ((t (:family "courier")))) (font-lock-builtin-face ((t (:foreground "Orchid")))) (font-lock-comment-face ((t (:italic t :foreground "Firebrick" :slant oblique)))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-function-name-face ((t (:bold t :foreground "Blue" :weight extra-bold :family "outline-verdana")))) (font-lock-keyword-face ((t (:bold t :foreground "Purple" :weight semi-bold :family "outline-verdana")))) (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) (font-lock-reference-face ((t (:foreground "Orchid")))) (font-lock-string-face ((t (:foreground "RosyBrown")))) (font-lock-type-face ((t (:italic t :foreground "ForestGreen" :slant italic)))) (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod" :width condensed)))) (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) (fringe ((t (:background "DarkSlateBlue")))) (header-line ((t (:box (:line-width -1 :style released-button) :background "grey90" :foreground "grey20" :box nil)))) (highlight ((t (:background "darkseagreen2")))) (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) (italic ((t (:italic t :slant italic)))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) (jde-java-font-lock-api-face ((t (:foreground "dark goldenrod")))) (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) (jde-java-font-lock-code-face ((t (nil)))) (jde-java-font-lock-constant-face ((t (:foreground "CadetBlue")))) (jde-java-font-lock-doc-tag-face ((t (:foreground "green4")))) (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) (jde-java-font-lock-modifier-face ((t (:foreground "Orchid")))) (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) (jde-java-font-lock-package-face ((t (:foreground "blue3")))) (jde-java-font-lock-pre-face ((t (nil)))) (jde-java-font-lock-underline-face ((t (:underline t)))) (menu ((t (nil)))) (modeline ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (modeline-buffer-id ((t (:background "grey75" :foreground "black")))) (modeline-mousable ((t (:background "grey75" :foreground "black")))) (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black")))) (mouse ((t (:background "black")))) (primary-selection ((t (:background "lightgoldenrod2")))) (region ((t (:background "lightgoldenrod2")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "yellow")))) (semantic-dirty-token-face ((t (:background "lightyellow")))) (semantic-unmatched-syntax-face ((t (:underline "red")))) (senator-intangible-face ((t (:foreground "gray25")))) (senator-momentary-highlight-face ((t (:background "gray70")))) (senator-read-only-face ((t (:background "#CCBBBB")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-tag-face ((t (:foreground "brown")))) (template-message-face ((t (:bold t :weight bold)))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85")))) (zmacs-region ((t (:background "lightgoldenrod2"))))))) (defun color-theme-black-on-gray () "Color theme by sbhojwani, created 2002-04-03. Includes ecb, font-lock, paren, semantic, and widget faces. Some of the font-lock faces are disabled, ie. they look just like the default face. This is for people that don't like the look of \"angry fruit salad\" when editing." (interactive) (color-theme-install '(color-theme-black-on-gray ((background-color . "white") (background-mode . light) (border-color . "blue") (foreground-color . "black")) ((buffers-tab-face . buffers-tab) (ecb-directories-general-face . ecb-default-general-face) (ecb-directory-face . ecb-default-highlight-face) (ecb-history-face . ecb-default-highlight-face) (ecb-history-general-face . ecb-default-general-face) (ecb-method-face . ecb-default-highlight-face) (ecb-methods-general-face . ecb-default-general-face) (ecb-source-face . ecb-default-highlight-face) (ecb-source-in-directories-buffer-face . ecb-source-in-directories-buffer-face) (ecb-sources-general-face . ecb-default-general-face) (ecb-token-header-face . ecb-token-header-face)) (default ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t :size "10pt")))) (bold-italic ((t (:italic t :bold t :size "10pt")))) (border-glyph ((t (:size "11pt")))) (buffers-tab ((t (:background "gray75")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "red")))) (ecb-bucket-token-face ((t (:bold t :size "10pt")))) (ecb-default-general-face ((t (nil)))) (ecb-default-highlight-face ((t (:background "cornflower blue" :foreground "yellow")))) (ecb-directories-general-face ((t (nil)))) (ecb-directory-face ((t (:background "cornflower blue" :foreground "yellow")))) (ecb-history-face ((t (:background "cornflower blue" :foreground "yellow")))) (ecb-history-general-face ((t (nil)))) (ecb-method-face ((t (:background "cornflower blue" :foreground "yellow")))) (ecb-methods-general-face ((t (nil)))) (ecb-source-face ((t (:background "cornflower blue" :foreground "yellow")))) (ecb-source-in-directories-buffer-face ((t (:foreground "medium blue")))) (ecb-sources-general-face ((t (nil)))) (ecb-token-header-face ((t (:background "SeaGreen1")))) (ecb-type-token-class-face ((t (:bold t :size "10pt")))) (ecb-type-token-enum-face ((t (:bold t :size "10pt")))) (ecb-type-token-group-face ((t (:bold t :size "10pt" :foreground "dimgray")))) (ecb-type-token-interface-face ((t (:bold t :size "10pt")))) (ecb-type-token-struct-face ((t (:bold t :size "10pt")))) (ecb-type-token-typedef-face ((t (:bold t :size "10pt")))) (font-lock-builtin-face ((t (:foreground "red3")))) (font-lock-constant-face ((t (:foreground "blue3")))) (font-lock-comment-face ((t (:foreground "blue")))) (font-lock-doc-face ((t (:foreground "green4")))) (font-lock-doc-string-face ((t (:foreground "green4")))) (font-lock-function-name-face ((t (nil)))) (font-lock-keyword-face ((t (nil)))) (font-lock-preprocessor-face ((t (:foreground "blue3")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (nil)))) (font-lock-type-face ((t (nil)))) (font-lock-variable-name-face ((t (nil)))) (font-lock-warning-face ((t (nil)))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75")))) (gui-element ((t (:size "8pt" :background "gray75")))) (highlight ((t (:background "darkseagreen2")))) (isearch ((t (:background "paleturquoise")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (:size "10pt")))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68")))) (modeline ((t (:background "gray75")))) (modeline-buffer-id ((t (:background "gray75" :foreground "blue4")))) (modeline-mousable ((t (:background "gray75" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:background "gray75" :foreground "green4")))) (paren-blink-off ((t (:foreground "gray")))) (paren-match ((t (:background "darkseagreen2")))) (paren-mismatch ((t (nil)))) (pointer ((t (nil)))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (region ((t (:background "gray65")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "paleturquoise")))) (semantic-dirty-token-face ((t (nil)))) (semantic-unmatched-syntax-face ((t (nil)))) (text-cursor ((t (:background "red" :foreground "gray")))) (toolbar ((t (:background "gray75")))) (underline ((t (:underline t)))) (vertical-divider ((t (:background "gray75")))) (widget ((t (:size "8pt" :background "gray75")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (nil)))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "gray65"))))))) (defun color-theme-dark-blue2 () "Color theme by Chris McMahan, created 2002-04-12. Includes antlr, bbdb, change-log, comint, cperl, custom cvs, diff, dired, display-time, ebrowse, ecb, ediff, erc, eshell, fl, font-lock, gnus, hi, highlight, html-helper, hyper-apropos, info, isearch, jde, message, mmm, paren, semantic, senator, sgml, smerge, speedbar, strokes, term, vhdl, viper, vm, widget, xref, xsl, xxml. Yes, it is a large theme." (interactive) (color-theme-install '(color-theme-dark-blue2 ((background-color . "#233b5a") (background-mode . dark) (background-toolbar-color . "#cf3ccf3ccf3c") (border-color . "black") (bottom-toolbar-shadow-color . "#79e77df779e7") (cursor-color . "Yellow") (foreground-color . "#fff8dc") (mouse-color . "Grey") (top-toolbar-shadow-color . "#fffffbeeffff") (viper-saved-cursor-color-in-replace-mode . "Red3")) ((blank-space-face . blank-space-face) (blank-tab-face . blank-tab-face) (cperl-invalid-face . underline) (ecb-directories-general-face . ecb-directories-general-face) (ecb-directory-face . ecb-directory-face) (ecb-history-face . ecb-history-face) (ecb-history-general-face . ecb-history-general-face) (ecb-method-face . ecb-method-face) (ecb-methods-general-face . ecb-methods-general-face) (ecb-source-face . ecb-source-face) (ecb-source-in-directories-buffer-face . ecb-sources-face) (ecb-sources-general-face . ecb-sources-general-face) (ecb-token-header-face . ecb-token-header-face) (gnus-article-button-face . bold) (gnus-article-mouse-face . highlight) (gnus-cite-attribution-face . gnus-cite-attribution-face) (gnus-signature-face . gnus-signature-face) (gnus-summary-selected-face . gnus-summary-selected-face) (help-highlight-face . underline) (highline-face . highline-face) (highline-vertical-face . highline-vertical-face) (list-matching-lines-face . bold) (ps-zebra-color . 0.95) (senator-eldoc-use-color . t) (sgml-set-face . t) (tags-tag-face . default) (view-highlight-face . highlight) (vm-highlight-url-face . bold-italic) (vm-highlighted-header-face . bold) (vm-mime-button-face . gui-button-face) (vm-summary-highlight-face . bold) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "#233b5a" :foreground "#fff8dc" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida console")))) (Info-title-1-face ((t (:bold t :weight bold :height 1.728 :family "helv")))) (Info-title-2-face ((t (:bold t :weight bold :height 1.44 :family "helv")))) (Info-title-3-face ((t (:bold t :weight bold :height 1.2 :family "helv")))) (Info-title-4-face ((t (:bold t :weight bold :family "helv")))) (antlr-font-lock-keyword-face ((t (:bold t :foreground "Gray85" :weight bold)))) (antlr-font-lock-literal-face ((t (:bold t :foreground "Gray85" :weight bold)))) (antlr-font-lock-ruledef-face ((t (:bold t :foreground "Gray85" :weight bold)))) (antlr-font-lock-ruleref-face ((t (:foreground "Gray85")))) (antlr-font-lock-tokendef-face ((t (:bold t :foreground "Gray85" :weight bold)))) (antlr-font-lock-tokenref-face ((t (:foreground "Gray85")))) (bbdb-company ((t (:italic t :slant italic)))) (bbdb-field-name ((t (:bold t :weight bold)))) (bbdb-field-value ((t (nil)))) (bbdb-name ((t (:underline t)))) (bg:erc-color-face0 ((t (:background "White")))) (bg:erc-color-face1 ((t (:background "black")))) (bg:erc-color-face10 ((t (:background "lightblue1")))) (bg:erc-color-face11 ((t (:background "cyan")))) (bg:erc-color-face12 ((t (:background "blue")))) (bg:erc-color-face13 ((t (:background "deeppink")))) (bg:erc-color-face14 ((t (:background "gray50")))) (bg:erc-color-face15 ((t (:background "gray90")))) (bg:erc-color-face2 ((t (:background "blue4")))) (bg:erc-color-face3 ((t (:background "green4")))) (bg:erc-color-face4 ((t (:background "red")))) (bg:erc-color-face5 ((t (:background "brown")))) (bg:erc-color-face6 ((t (:background "purple")))) (bg:erc-color-face7 ((t (:background "orange")))) (bg:erc-color-face8 ((t (:background "yellow")))) (bg:erc-color-face9 ((t (:background "green")))) (blank-space-face ((t (:background "LightGray")))) (blank-tab-face ((t (:background "Wheat")))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t :foreground "cyan" :weight bold)))) (bold-italic ((t (:italic t :bold t :foreground "cyan2" :slant italic :weight bold)))) (border ((t (:background "black")))) (border-glyph ((t (nil)))) (buffers-tab ((t (:background "gray30" :foreground "LightSkyBlue")))) (calendar-today-face ((t (:underline t)))) (change-log-acknowledgement-face ((t (:foreground "firebrick")))) (change-log-conditionals-face ((t (:background "sienna" :foreground "khaki")))) (change-log-date-face ((t (:foreground "gold")))) (change-log-email-face ((t (:foreground "khaki" :underline t)))) (change-log-file-face ((t (:bold t :foreground "lemon chiffon" :weight bold)))) (change-log-function-face ((t (:background "sienna" :foreground "khaki")))) (change-log-list-face ((t (:foreground "wheat")))) (change-log-name-face ((t (:bold t :foreground "light goldenrod" :weight bold)))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (comint-input-face ((t (:foreground "deepskyblue")))) (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) (cperl-invalid-face ((t (:foreground "white")))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (cursor ((t (:background "Yellow")))) (custom-button-face ((t (:bold t :weight bold)))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "gray30")))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:foreground "white")))) (custom-comment-tag-face ((t (:foreground "white")))) (custom-documentation-face ((t (:foreground "light blue")))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:bold t :foreground "gray85" :underline t :weight bold)))) (custom-group-tag-face-1 ((t (:foreground "gray85" :underline t)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "gray30" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "gray85")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :foreground "gray85" :underline t :weight bold)))) (cvs-filename-face ((t (:foreground "white")))) (cvs-handled-face ((t (:foreground "pink")))) (cvs-header-face ((t (:foreground "green")))) (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) (cvs-msg-face ((t (:foreground "gray85")))) (cvs-need-action-face ((t (:foreground "yellow")))) (cvs-unknown-face ((t (:foreground "grey")))) (cyan ((t (:foreground "cyan")))) (diary-face ((t (:bold t :foreground "gray85" :weight bold)))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-context-face ((t (:foreground "grey50")))) (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) (diff-function-face ((t (:foreground "grey50")))) (diff-header-face ((t (:foreground "lemon chiffon")))) (diff-hunk-header-face ((t (:background "grey85")))) (diff-index-face ((t (:bold t :background "grey70" :weight bold)))) (diff-nonexistent-face ((t (:bold t :background "grey70" :weight bold)))) (diff-removed-face ((t (nil)))) (dired-face-boring ((t (:foreground "Gray65")))) (dired-face-directory ((t (:bold t :weight bold)))) (dired-face-executable ((t (:foreground "gray85")))) (dired-face-flagged ((t (:background "LightSlateGray")))) (dired-face-header ((t (:background "grey75" :foreground "gray30")))) (dired-face-marked ((t (:background "PaleVioletRed")))) (dired-face-permissions ((t (:background "grey75" :foreground "gray30")))) (dired-face-setuid ((t (:foreground "gray85")))) (dired-face-socket ((t (:foreground "gray85")))) (dired-face-symlink ((t (:foreground "cyan")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "gray85")))) (ebrowse-default-face ((t (nil)))) (ebrowse-file-name-face ((t (:italic t :slant italic)))) (ebrowse-member-attribute-face ((t (:foreground "red")))) (ebrowse-member-class-face ((t (:foreground "Gray85")))) (ebrowse-progress-face ((t (:background "blue")))) (ebrowse-root-class-face ((t (:bold t :foreground "Gray85" :weight bold)))) (ebrowse-tree-mark-face ((t (:foreground "Gray85")))) (ecb-bucket-token-face ((t (:bold t :weight bold)))) (ecb-default-general-face ((t (:height 1.0)))) (ecb-default-highlight-face ((t (:background "magenta" :height 1.0)))) (ecb-directories-general-face ((t (:height 0.9)))) (ecb-directory-face ((t (:background "Cyan4")))) (ecb-history-face ((t (:background "Cyan4")))) (ecb-history-general-face ((t (:height 0.9)))) (ecb-method-face ((t (:background "Cyan4" :slant normal :weight normal)))) (ecb-methods-general-face ((t (:slant normal)))) (ecb-source-face ((t (:background "Cyan4")))) (ecb-source-in-directories-buffer-face ((t (:foreground "LightBlue1")))) (ecb-sources-face ((t (:foreground "LightBlue1")))) (ecb-sources-general-face ((t (:height 0.9)))) (ecb-token-header-face ((t (:background "Steelblue4")))) (ecb-type-token-class-face ((t (:bold t :weight bold)))) (ecb-type-token-enum-face ((t (:bold t :weight bold)))) (ecb-type-token-group-face ((t (:bold t :foreground "dim gray" :weight bold)))) (ecb-type-token-interface-face ((t (:bold t :weight bold)))) (ecb-type-token-struct-face ((t (:bold t :weight bold)))) (ecb-type-token-typedef-face ((t (:bold t :weight bold)))) (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Gray30")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Gray30")))) (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Gray30")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Gray30")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Gray30")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Gray30")))) (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Gray30")))) (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Gray30")))) (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) (erc-action-face ((t (:bold t :weight bold)))) (erc-bold-face ((t (:bold t :weight bold)))) (erc-dangerous-host-face ((t (:foreground "red")))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "pale green")))) (erc-error-face ((t (:bold t :foreground "gray85" :weight bold)))) (erc-fool-face ((t (:foreground "Gray85")))) (erc-highlight-face ((t (:bold t :foreground "pale green" :weight bold)))) (erc-input-face ((t (:foreground "light blue")))) (erc-inverse-face ((t (:background "Black" :foreground "White")))) (erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold)))) (erc-notice-face ((t (:foreground "light salmon")))) (erc-pal-face ((t (:foreground "pale green")))) (erc-prompt-face ((t (:bold t :foreground "light blue" :weight bold)))) (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) (erc-underline-face ((t (:underline t)))) (eshell-ls-archive-face ((t (:bold t :weight bold)))) (eshell-ls-backup-face ((t (:foreground "gray85")))) (eshell-ls-clutter-face ((t (:bold t :foreground "gray85" :weight bold)))) (eshell-ls-directory-face ((t (:bold t :foreground "Cyan" :weight bold)))) (eshell-ls-executable-face ((t (:bold t :weight bold)))) (eshell-ls-missing-face ((t (:bold t :weight bold)))) (eshell-ls-picture-face ((t (:foreground "gray85")))) (eshell-ls-product-face ((t (:foreground "gray85")))) (eshell-ls-readonly-face ((t (:foreground "gray70")))) (eshell-ls-special-face ((t (:bold t :weight bold)))) (eshell-ls-symlink-face ((t (:bold t :weight bold)))) (eshell-ls-text-face ((t (:foreground "gray85")))) (eshell-ls-todo-face ((t (:bold t :weight bold)))) (eshell-ls-unreadable-face ((t (:foreground "gray85")))) (eshell-prompt-face ((t (:bold t :foreground "Yellow" :weight bold)))) (eshell-test-failed-face ((t (:bold t :weight bold)))) (eshell-test-ok-face ((t (:bold t :weight bold)))) (excerpt ((t (:italic t :slant italic)))) (ff-paths-non-existant-file-face ((t (:bold t :foreground "gray85" :weight bold)))) (fg:black ((t (:foreground "black")))) (fg:erc-color-face0 ((t (:foreground "White")))) (fg:erc-color-face1 ((t (:foreground "black")))) (fg:erc-color-face10 ((t (:foreground "lightblue1")))) (fg:erc-color-face11 ((t (:foreground "cyan")))) (fg:erc-color-face12 ((t (:foreground "blue")))) (fg:erc-color-face13 ((t (:foreground "deeppink")))) (fg:erc-color-face14 ((t (:foreground "gray50")))) (fg:erc-color-face15 ((t (:foreground "gray90")))) (fg:erc-color-face2 ((t (:foreground "blue4")))) (fg:erc-color-face3 ((t (:foreground "green4")))) (fg:erc-color-face4 ((t (:foreground "red")))) (fg:erc-color-face5 ((t (:foreground "brown")))) (fg:erc-color-face6 ((t (:foreground "purple")))) (fg:erc-color-face7 ((t (:foreground "orange")))) (fg:erc-color-face8 ((t (:foreground "yellow")))) (fg:erc-color-face9 ((t (:foreground "green")))) (fixed ((t (:bold t :weight bold)))) (fixed-pitch ((t (:family "outline-lucida console")))) (fl-comment-face ((t (:foreground "gray85")))) (fl-function-name-face ((t (:foreground "green")))) (fl-keyword-face ((t (:foreground "LightGreen")))) (fl-string-face ((t (:foreground "light coral")))) (fl-type-face ((t (:foreground "cyan")))) (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) (font-latex-bold-face ((t (nil)))) (font-latex-italic-face ((t (nil)))) (font-latex-math-face ((t (nil)))) (font-latex-sedate-face ((t (:foreground "Gray85")))) (font-latex-string-face ((t (:foreground "orange")))) (font-latex-warning-face ((t (:foreground "gold")))) (font-lock-builtin-face ((t (:bold t :foreground "LightSteelBlue" :weight bold)))) (font-lock-comment-face ((t (:italic t :foreground "medium aquamarine" :slant italic)))) (font-lock-constant-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) (font-lock-doc-face ((t (:bold t :weight bold)))) (font-lock-doc-string-face ((t (:bold t :foreground "aquamarine" :weight bold)))) (font-lock-exit-face ((t (:foreground "green")))) (font-lock-function-name-face ((t (:italic t :bold t :foreground "LightSkyBlue" :slant italic :weight bold)))) (font-lock-keyword-face ((t (:bold t :foreground "Cyan" :weight bold)))) (font-lock-preprocessor-face ((t (:foreground "Gray85")))) (font-lock-reference-face ((t (:foreground "cyan")))) (font-lock-string-face ((t (:italic t :foreground "aquamarine" :slant italic)))) (font-lock-type-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) (font-lock-variable-name-face ((t (:italic t :bold t :foreground "LightGoldenrod" :slant italic :weight bold)))) (font-lock-warning-face ((t (:bold t :foreground "Salmon" :weight bold)))) (fringe ((t (:background "#3c5473")))) (gnus-cite-attribution-face ((t (:italic t :bold t :foreground "beige" :underline t :slant italic :weight bold)))) (gnus-cite-face-1 ((t (:foreground "gold")))) (gnus-cite-face-10 ((t (:foreground "coral")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "wheat")))) (gnus-cite-face-3 ((t (:foreground "light pink")))) (gnus-cite-face-4 ((t (:foreground "khaki")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:foreground "beige")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t :foreground "light gray" :weight bold)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :foreground "cyan" :slant italic :weight bold)))) (gnus-emphasis-highlight-words ((t (:background "gray30" :foreground "gold")))) (gnus-emphasis-italic ((t (:italic t :foreground "cyan" :slant italic)))) (gnus-emphasis-underline ((t (:foreground "white" :underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :foreground "white" :underline t :weight bold)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :foreground "white" :underline t :slant italic :weight bold)))) (gnus-emphasis-underline-italic ((t (:italic t :foreground "white" :underline t :slant italic)))) (gnus-filterhist-face-1 ((t (nil)))) (gnus-group-mail-1-empty-face ((t (:foreground "Magenta")))) (gnus-group-mail-1-face ((t (:bold t :foreground "Magenta" :weight bold)))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) (gnus-group-mail-3-empty-face ((t (:foreground "Cyan")))) (gnus-group-mail-3-face ((t (:bold t :foreground "Cyan" :weight bold)))) (gnus-group-mail-low-empty-face ((t (:foreground "Wheat")))) (gnus-group-mail-low-face ((t (:bold t :foreground "Gray85" :weight bold)))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) (gnus-group-news-3-empty-face ((t (:foreground "wheat")))) (gnus-group-news-3-face ((t (:bold t :foreground "Wheat" :weight bold)))) (gnus-group-news-4-empty-face ((t (:foreground "Aquamarine")))) (gnus-group-news-4-face ((t (:bold t :weight bold)))) (gnus-group-news-5-empty-face ((t (:foreground "MediumAquamarine")))) (gnus-group-news-5-face ((t (:bold t :weight bold)))) (gnus-group-news-6-empty-face ((t (:foreground "MediumAquamarine")))) (gnus-group-news-6-face ((t (:bold t :weight bold)))) (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) (gnus-header-content-face ((t (:italic t :foreground "Wheat" :slant italic)))) (gnus-header-from-face ((t (:bold t :foreground "light yellow" :weight bold)))) (gnus-header-name-face ((t (:bold t :foreground "Wheat" :weight bold)))) (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "gold" :slant italic :weight bold)))) (gnus-header-subject-face ((t (:bold t :foreground "Gold" :weight bold)))) (gnus-picons-face ((t (:background "white" :foreground "gray30")))) (gnus-picons-xbm-face ((t (:background "white" :foreground "gray30")))) (gnus-signature-face ((t (:italic t :foreground "white" :slant italic)))) (gnus-splash ((t (:foreground "Brown")))) (gnus-splash-face ((t (:foreground "orange")))) (gnus-summary-cancelled-face ((t (:background "gray30" :foreground "orange")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) (gnus-summary-high-read-face ((t (:bold t :foreground "gray85" :weight bold)))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "coral" :weight bold)))) (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "gold" :slant italic :weight bold)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) (gnus-summary-low-read-face ((t (:italic t :foreground "gray85" :slant italic)))) (gnus-summary-low-ticked-face ((t (:italic t :bold t :foreground "coral" :slant italic :weight bold)))) (gnus-summary-low-unread-face ((t (:italic t :foreground "white" :slant italic)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "gray70")))) (gnus-summary-normal-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) (gnus-summary-normal-unread-face ((t (:bold t :foreground "gray85" :weight bold)))) (gnus-summary-selected-face ((t (:foreground "white" :underline t)))) (gnus-x-face ((t (:background "white" :foreground "gray30")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "gray30")))) (gui-element ((t (:background "Gray80")))) (header-line ((t (:background "grey20" :foreground "grey90")))) (hi-black-b ((t (:bold t :weight bold)))) (hi-black-hb ((t (:bold t :weight bold :height 1.67 :family "helv")))) (hi-blue ((t (:background "light blue")))) (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) (hi-green ((t (:background "green")))) (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) (hi-pink ((t (:background "pink")))) (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) (hi-yellow ((t (:background "yellow")))) (highlight ((t (:background "SkyBlue3")))) (highlight-changes-delete-face ((t (:foreground "gray85" :underline t)))) (highlight-changes-face ((t (:foreground "gray85")))) (highline-face ((t (:background "#3c5473")))) (highline-vertical-face ((t (:background "lightcyan")))) (holiday-face ((t (:background "pink" :foreground "gray30")))) (html-helper-bold-face ((t (:bold t :weight bold)))) (html-helper-bold-italic-face ((t (nil)))) (html-helper-builtin-face ((t (:foreground "gray85" :underline t)))) (html-helper-italic-face ((t (:bold t :foreground "yellow" :weight bold)))) (html-helper-underline-face ((t (:underline t)))) (html-tag-face ((t (:bold t :weight bold)))) (hyper-apropos-documentation ((t (:foreground "white")))) (hyper-apropos-heading ((t (:bold t :weight bold)))) (hyper-apropos-hyperlink ((t (:foreground "sky blue")))) (hyper-apropos-major-heading ((t (:bold t :weight bold)))) (hyper-apropos-section-heading ((t (:bold t :weight bold)))) (hyper-apropos-warning ((t (:bold t :foreground "gray85" :weight bold)))) (ibuffer-marked-face ((t (:foreground "gray85")))) (idlwave-help-link-face ((t (:foreground "Blue")))) (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) (info-header-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) (info-header-xref ((t (:bold t :foreground "magenta4" :weight bold)))) (info-menu-5 ((t (:underline t)))) (info-menu-6 ((t (nil)))) (info-menu-header ((t (:bold t :weight bold :family "helv")))) (info-node ((t (:italic t :bold t :slant italic :weight bold)))) (info-xref ((t (:bold t :weight bold)))) (isearch ((t (:background "LightSeaGreen")))) (isearch-lazy-highlight-face ((t (:background "cyan4")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (:italic t :bold t :slant italic :weight bold)))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) (jde-java-font-lock-api-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) (jde-java-font-lock-code-face ((t (nil)))) (jde-java-font-lock-constant-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-doc-tag-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) (jde-java-font-lock-link-face ((t (:foreground "cyan3" :underline t)))) (jde-java-font-lock-modifier-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) (jde-java-font-lock-operator-face ((t (:foreground "cyan3")))) (jde-java-font-lock-package-face ((t (:foreground "LightBlue")))) (jde-java-font-lock-pre-face ((t (nil)))) (jde-java-font-lock-underline-face ((t (:underline t)))) (lazy-highlight-face ((t (:bold t :foreground "yellow" :weight bold)))) (left-margin ((t (nil)))) (linemenu-face ((t (:background "gray30")))) (list-mode-item-selected ((t (:background "gray68")))) (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) (log-view-message-face ((t (:background "grey85")))) (magenta ((t (:foreground "gray85")))) (makefile-space-face ((t (:background "hotpink" :foreground "white")))) (man-bold ((t (:bold t :weight bold)))) (man-heading ((t (:bold t :weight bold)))) (man-italic ((t (:foreground "yellow")))) (man-xref ((t (:underline t)))) (menu ((t (:background "wheat" :foreground "gray30")))) (message-cited-text ((t (:foreground "orange")))) (message-cited-text-face ((t (:foreground "medium aquamarine")))) (message-header-cc-face ((t (:bold t :foreground "gray85" :weight bold)))) (message-header-contents ((t (:foreground "white")))) (message-header-name-face ((t (:foreground "gray85")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) (message-header-other-face ((t (:foreground "gray85")))) (message-header-subject-face ((t (:bold t :foreground "green3" :weight bold)))) (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) (message-header-xheader-face ((t (:foreground "blue")))) (message-headers ((t (:bold t :foreground "orange" :weight bold)))) (message-highlighted-header-contents ((t (:bold t :weight bold)))) (message-mml-face ((t (:bold t :foreground "gray85" :weight bold)))) (message-separator-face ((t (:foreground "gray85")))) (message-url ((t (:bold t :foreground "pink" :weight bold)))) (mmm-default-submode-face ((t (:background "#c0c0c5")))) (mmm-face ((t (:background "black" :foreground "green")))) (modeline ((t (:background "#3c5473" :foreground "lightgray" :box (:line-width -1 :style released-button :family "helv"))))) (modeline-buffer-id ((t (:background "white" :foreground "DeepSkyBlue3" :slant normal :weight normal :width normal :family "outline-verdana")))) (modeline-mousable ((t (:background "white" :foreground "DeepSkyBlue3")))) (modeline-mousable-minor-mode ((t (:background "white" :foreground "DeepSkyBlue3")))) (mouse ((t (:background "Grey")))) (my-summary-highlight-face ((t (:background "PaleTurquoise4" :foreground "White")))) (my-url-face ((t (:foreground "LightBlue")))) (nil ((t (nil)))) (paren-blink-off ((t (:foreground "gray80")))) (paren-face-match ((t (:background "turquoise")))) (paren-face-mismatch ((t (:background "purple" :foreground "white")))) (paren-face-no-match ((t (:background "yellow" :foreground "gray30")))) (paren-match ((t (:background "darkseagreen2")))) (paren-mismatch ((t (:background "RosyBrown" :foreground "gray30")))) (paren-mismatch-face ((t (:bold t :background "white" :foreground "red" :weight bold)))) (paren-no-match-face ((t (:bold t :background "white" :foreground "red" :weight bold)))) (pointer ((t (nil)))) (primary-selection ((t (:background "gray40")))) (reb-match-0 ((t (:background "lightblue")))) (reb-match-1 ((t (:background "aquamarine")))) (reb-match-2 ((t (:background "springgreen")))) (reb-match-3 ((t (:background "yellow")))) (red ((t (:foreground "red")))) (region ((t (:background "Cyan4")))) (right-margin ((t (nil)))) (scroll-bar ((t (:background "grey75")))) (secondary-selection ((t (:background "gray60")))) (semantic-dirty-token-face ((t (:background "gray10")))) (semantic-intangible-face ((t (:foreground "gray25")))) (semantic-read-only-face ((t (:background "gray25")))) (semantic-unmatched-syntax-face ((t (:underline "red")))) (senator-intangible-face ((t (:foreground "gray75")))) (senator-momentary-highlight-face ((t (:background "gray70")))) (senator-read-only-face ((t (:background "#664444")))) (sgml-comment-face ((t (:foreground "dark turquoise")))) (sgml-doctype-face ((t (:foreground "turquoise")))) (sgml-end-tag-face ((t (:foreground "aquamarine")))) (sgml-entity-face ((t (:foreground "gray85")))) (sgml-ignored-face ((t (:background "gray60" :foreground "gray40")))) (sgml-ms-end-face ((t (:foreground "green")))) (sgml-ms-start-face ((t (:foreground "yellow")))) (sgml-pi-face ((t (:foreground "lime green")))) (sgml-sgml-face ((t (:foreground "brown")))) (sgml-short-ref-face ((t (:foreground "deep sky blue")))) (sgml-start-tag-face ((t (:foreground "aquamarine")))) (sh-heredoc-face ((t (:foreground "tan")))) (shell-option-face ((t (:foreground "gray85")))) (shell-output-2-face ((t (:foreground "gray85")))) (shell-output-3-face ((t (:foreground "gray85")))) (shell-output-face ((t (:bold t :weight bold)))) (shell-prompt-face ((t (:foreground "yellow")))) (show-paren-match-face ((t (:bold t :background "turquoise" :weight bold)))) (show-paren-mismatch-face ((t (:bold t :background "RosyBrown" :foreground "white" :weight bold)))) (show-tabs-space-face ((t (:foreground "yellow")))) (show-tabs-tab-face ((t (:foreground "red")))) (smerge-base-face ((t (:foreground "red")))) (smerge-markers-face ((t (:background "grey85")))) (smerge-mine-face ((t (:foreground "Gray85")))) (smerge-other-face ((t (:foreground "darkgreen")))) (speedbar-button-face ((t (:bold t :weight bold)))) (speedbar-directory-face ((t (:bold t :weight bold)))) (speedbar-file-face ((t (:bold t :weight bold)))) (speedbar-highlight-face ((t (:background "sea green")))) (speedbar-selected-face ((t (:underline t)))) (speedbar-tag-face ((t (:foreground "yellow")))) (strokes-char-face ((t (:background "lightgray")))) (swbuff-current-buffer-face ((t (:bold t :foreground "gray85" :weight bold)))) (template-message-face ((t (:bold t :weight bold)))) (term-black ((t (:foreground "black")))) (term-blackbg ((t (:background "black")))) (term-blue ((t (:foreground "blue")))) (term-bluebg ((t (:background "blue")))) (term-bold ((t (:bold t :weight bold)))) (term-cyan ((t (:foreground "cyan")))) (term-cyanbg ((t (:background "cyan")))) (term-default ((t (:background "gray80" :foreground "gray30" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida console")))) (term-default-bg ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-default-fg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-green ((t (:foreground "green")))) (term-greenbg ((t (:background "green")))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-magenta ((t (:foreground "magenta")))) (term-magentabg ((t (:background "magenta")))) (term-red ((t (:foreground "red")))) (term-redbg ((t (:background "red")))) (term-underline ((t (:underline t)))) (term-white ((t (:foreground "white")))) (term-whitebg ((t (:background "white")))) (term-yellow ((t (:foreground "yellow")))) (term-yellowbg ((t (:background "yellow")))) (tex-math-face ((t (:foreground "RosyBrown")))) (texinfo-heading-face ((t (:foreground "Blue")))) (text-cursor ((t (:background "Red3" :foreground "gray80")))) (tool-bar ((t (:background "grey75" :foreground "black")))) (toolbar ((t (:background "Gray80")))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (vc-annotate-face-0046FF ((t (:background "black" :foreground "wheat")))) (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) (vertical-divider ((t (:background "Gray80")))) (vhdl-font-lock-attribute-face ((t (:foreground "gray85")))) (vhdl-font-lock-directive-face ((t (:foreground "gray85")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "gray85")))) (vhdl-font-lock-function-face ((t (:foreground "gray85")))) (vhdl-font-lock-prompt-face ((t (:bold t :foreground "gray85" :weight bold)))) (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "gray85" :weight bold)))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-speedbar-architecture-face ((t (:foreground "gray85")))) (vhdl-speedbar-architecture-selected-face ((t (:foreground "gray85" :underline t)))) (vhdl-speedbar-configuration-face ((t (:foreground "gray85")))) (vhdl-speedbar-configuration-selected-face ((t (:foreground "gray85" :underline t)))) (vhdl-speedbar-entity-face ((t (:foreground "gray85")))) (vhdl-speedbar-entity-selected-face ((t (:foreground "gray85" :underline t)))) (vhdl-speedbar-instantiation-face ((t (:foreground "gray85")))) (vhdl-speedbar-instantiation-selected-face ((t (:foreground "gray85" :underline t)))) (vhdl-speedbar-package-face ((t (:foreground "gray85")))) (vhdl-speedbar-package-selected-face ((t (:foreground "gray85" :underline t)))) (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-search-face ((t (:background "khaki" :foreground "Black")))) (vm-header-content-face ((t (:italic t :foreground "wheat" :slant italic)))) (vm-header-from-face ((t (:italic t :foreground "wheat" :slant italic)))) (vm-header-name-face ((t (:foreground "cyan")))) (vm-header-subject-face ((t (:foreground "cyan")))) (vm-header-to-face ((t (:italic t :foreground "cyan" :slant italic)))) (vm-message-cited-face ((t (:foreground "Gray80")))) (vm-monochrome-image ((t (:background "white" :foreground "gray30")))) (vm-summary-face-1 ((t (:foreground "MediumAquamarine")))) (vm-summary-face-2 ((t (:foreground "MediumAquamarine")))) (vm-summary-face-3 ((t (:foreground "MediumAquamarine")))) (vm-summary-face-4 ((t (:foreground "MediumAquamarine")))) (vm-summary-highlight-face ((t (:foreground "White")))) (vm-xface ((t (:background "white" :foreground "gray30")))) (vmpc-pre-sig-face ((t (:foreground "gray85")))) (vmpc-sig-face ((t (:foreground "gray85")))) (vvb-face ((t (:background "pink" :foreground "gray30")))) (w3m-anchor-face ((t (:bold t :foreground "gray85" :weight bold)))) (w3m-arrived-anchor-face ((t (:bold t :foreground "gray85" :weight bold)))) (w3m-header-line-location-content-face ((t (:background "dark olive green" :foreground "wheat")))) (w3m-header-line-location-title-face ((t (:background "dark olive green" :foreground "beige")))) (white ((t (:foreground "white")))) (widget ((t (nil)))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "gray85")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85" :foreground "gray30")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "dim gray" :foreground "white")))) (woman-addition-face ((t (:foreground "orange")))) (woman-bold-face ((t (:bold t :weight bold)))) (woman-italic-face ((t (:foreground "beige")))) (woman-unknown-face ((t (:foreground "LightSalmon")))) (x-face ((t (:background "white" :foreground "gray30")))) (xrdb-option-name-face ((t (:foreground "gray85")))) (xref-keyword-face ((t (:foreground "gray85")))) (xref-list-default-face ((t (nil)))) (xref-list-pilot-face ((t (:foreground "gray85")))) (xref-list-symbol-face ((t (:foreground "navy")))) (xsl-fo-alternate-face ((t (:foreground "Yellow")))) (xsl-fo-main-face ((t (:foreground "PaleGreen")))) (xsl-other-element-face ((t (:foreground "Coral")))) (xsl-xslt-alternate-face ((t (:foreground "LightGray")))) (xsl-xslt-main-face ((t (:foreground "Wheat")))) (xxml-emph-1-face ((t (:background "lightyellow")))) (xxml-emph-2-face ((t (:background "lightyellow")))) (xxml-header-1-face ((t (:background "seashell1" :foreground "MediumAquamarine")))) (xxml-header-2-face ((t (:background "seashell1" :foreground "SkyBlue")))) (xxml-header-3-face ((t (:background "seashell1")))) (xxml-header-4-face ((t (:background "seashell1")))) (xxml-interaction-face ((t (:background "lightcyan")))) (xxml-rug-face ((t (:background "cyan")))) (xxml-sparkle-face ((t (:background "yellow")))) (xxml-unbreakable-space-face ((t (:foreground "grey" :underline t)))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "Cyan4"))))))) (defun color-theme-blue-mood () "Color theme by Nelson Loyola, created 2002-04-15. Includes cperl, custom, font-lock, p4, speedbar, widget." (interactive) (color-theme-install '(color-theme-blue-mood ((background-color . "DodgerBlue4") (background-mode . dark) (background-toolbar-color . "#bfbfbfbfbfbf") (border-color . "Blue") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#6c6c68686868") (cursor-color . "DarkGoldenrod1") (foreground-color . "white smoke") (mouse-color . "black") (top-toolbar-shadow-color . "#e5e5e0e0e1e1")) ((vc-annotate-very-old-color . "#0046FF")) (default ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (nil)))) (border-glyph ((t (nil)))) (cmode-bracket-face ((t (:bold t)))) (cperl-array-face ((t (:bold t :foreground "wheat")))) (cperl-hash-face ((t (:bold t :foreground "chartreuse")))) (custom-button-face ((t (nil)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:bold t :foreground "cyan")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "blue")))) (ff-paths-non-existant-file-face ((t (:bold t :foreground "NavyBlue")))) (font-lock-builtin-face ((t (:bold t :foreground "wheat")))) (font-lock-comment-face ((t (:bold t :foreground "gray72")))) (font-lock-constant-face ((t (:bold t :foreground "cyan3")))) (font-lock-doc-string-face ((t (:foreground "#00C000")))) (font-lock-function-name-face ((t (:bold t :foreground "chartreuse")))) (font-lock-keyword-face ((t (:bold t :foreground "gold1")))) (font-lock-other-emphasized-face ((t (:bold t :foreground "gold1")))) (font-lock-other-type-face ((t (:bold t :foreground "gold1")))) (font-lock-preprocessor-face ((t (:foreground "plum")))) (font-lock-reference-face ((t (:bold t :foreground "orangered")))) (font-lock-string-face ((t (:foreground "tomato")))) (font-lock-type-face ((t (:bold t :foreground "gold1")))) (font-lock-variable-name-face ((t (:foreground "light yellow")))) (font-lock-warning-face ((t (:foreground "tomato")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (:size "nil" :background "#e7e3d6" :foreground" #000000")))) (highlight ((t (:background "red" :foreground "yellow")))) (isearch ((t (:bold t :background "pale turquoise" :foreground "blue")))) (italic ((t (nil)))) (lazy-highlight-face ((t (:bold t :foreground "dark magenta")))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:bold t :background "gray68" :foreground "yellow")))) (modeline ((t (:background "goldenrod" :foreground "darkblue")))) (modeline-buffer-id ((t (:background "goldenrod" :foreground "darkblue")))) (modeline-mousable ((t (:background "goldenrod" :foreground "darkblue")))) (modeline-mousable-minor-mode ((t (:background "goldenrod" :foreground "darkblue")))) (my-tab-face ((t (:background "SlateBlue1")))) (p4-depot-added-face ((t (:foreground "steelblue1")))) (p4-depot-deleted-face ((t (:foreground "red")))) (p4-depot-unmapped-face ((t (:foreground "grey90")))) (p4-diff-change-face ((t (:foreground "dark green")))) (p4-diff-del-face ((t (:bold t :foreground "salmon")))) (p4-diff-file-face ((t (:background "blue")))) (p4-diff-head-face ((t (:background "blue")))) (p4-diff-ins-face ((t (:foreground "steelblue1")))) (paren-blink-off ((t (:foreground "DodgerBlue4")))) (paren-match ((t (:background "red" :foreground "yellow")))) (paren-mismatch ((t (:background "DeepPink")))) (pointer ((t (:background "white")))) (primary-selection ((t (:bold t :background "medium sea green")))) (red ((t (:foreground "red")))) (region ((t (:background "red" :foreground "yellow")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "gray91" :foreground "sienna3")))) (show-paren-match-face ((t (:background "cyan3" :foreground "blue")))) (show-paren-mismatch-face ((t (:background "red" :foreground "blue")))) (show-trailing-whitespace ((t (:background "red" :foreground "blue")))) (speedbar-button-face ((t (:foreground "white")))) (speedbar-directory-face ((t (:foreground "gray")))) (speedbar-file-face ((t (:foreground "gold1")))) (speedbar-highlight-face ((t (:background "lightslateblue" :foreground "gold1")))) (speedbar-selected-face ((t (:underline t :foreground "red")))) (speedbar-tag-face ((t (:foreground "chartreuse")))) (text-cursor ((t (:background "DarkGoldenrod1" :foreground "DodgerBlue4")))) (toolbar ((t (:background "#e7e3d6" :foreground "#000000")))) (underline ((t (:underline t)))) (vertical-divider ((t (:background "#e7e3d6" :foreground "#000000")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "white" :foreground "midnightblue"))))))) (defun color-theme-euphoria () "Color theme by oGLOWo, created 2000-04-19. Green on black theme including font-lock, speedbar, and widget." (interactive) (color-theme-install '(color-theme-euphoria ((background-color . "black") (background-mode . dark) (border-color . "black") (cursor-color . "yellow") (foreground-color . "#00ff00") (mouse-color . "yellow")) ((help-highlight-face . underline) (list-matching-lines-face . bold) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "black" :foreground "#00ff00" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "misc-fixed")))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cursor ((t (:background "yellow")))) (fixed-pitch ((t (:family "courier")))) (font-lock-builtin-face ((t (:foreground "magenta")))) (font-lock-comment-face ((t (:foreground "deeppink")))) (font-lock-constant-face ((t (:foreground "blue")))) (font-lock-doc-face ((t (:foreground "cyan")))) (font-lock-doc-string-face ((t (:foreground "cyan")))) (font-lock-function-name-face ((t (:foreground "purple")))) (font-lock-keyword-face ((t (:foreground "red")))) (font-lock-preprocessor-face ((t (:foreground "blue1")))) (font-lock-reference-face ((t (nil)))) (font-lock-string-face ((t (:foreground "cyan")))) (font-lock-type-face ((t (:foreground "yellow")))) (font-lock-variable-name-face ((t (:foreground "violet")))) (font-lock-warning-face ((t (:bold t :foreground "red" :weight bold)))) (fringe ((t (:background "gray16" :foreground "#00ff00")))) (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) (highlight ((t (:background "darkolivegreen")))) (horizontal-divider ((t (:background "gray16" :foreground "#00ff00")))) (isearch ((t (:background "palevioletred2" :foreground "brown4")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:italic t :slant italic)))) (menu ((t (:background "gray16" :foreground "green")))) (modeline ((t (:background "gray16" :foreground "#00ff00" :box (:line-width -1 :style released-button))))) (modeline-buffer-id ((t (:background "gray16" :foreground "#00ff00")))) (modeline-mousable ((t (:background "gray16" :foreground "#00ff00")))) (modeline-mousable-minor-mode ((t (:background "gray16" :foreground "#00ff00")))) (mouse ((t (:background "yellow")))) (primary-selection ((t (:background "#00ff00" :foreground "black")))) (region ((t (:background "steelblue" :foreground "white")))) (scroll-bar ((t (:background "gray16" :foreground "#00ff00")))) (secondary-selection ((t (:background "#00ff00" :foreground "black")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (speedbar-button-face ((t (:foreground "#00ff00")))) (speedbar-directory-face ((t (:foreground "#00ff00")))) (speedbar-file-face ((t (:foreground "cyan")))) (speedbar-highlight-face ((t (:background "#00ff00" :foreground "purple")))) (speedbar-selected-face ((t (:foreground "deeppink" :underline t)))) (speedbar-tag-face ((t (:foreground "yellow")))) (tool-bar ((t (:background "gray16" :foreground "green" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "gray16" :foreground "#00ff00")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (vertical-divider ((t (:background "gray16" :foreground "#00ff00")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray")))) (zmacs-region ((t (:background "steelblue" :foreground "white"))))))) (defun color-theme-resolve () "Color theme by Damien Elmes, created 2002-04-24. A white smoke on blue color theme." (interactive) (color-theme-install '(color-theme-resolve ((background-color . "#00457f") (background-mode . dark) (border-color . "black") (cursor-color . "DarkGoldenrod1") (foreground-color . "white smoke") (mouse-color . "white")) ((display-time-mail-face . mode-line) (help-highlight-face . underline) (list-matching-lines-face . bold) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "#00457f" :foreground "white smoke" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "b&h-lucidatypewriter")))) (bold ((t (:bold t :foreground "snow2" :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (calendar-today-face ((t (:underline t)))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cperl-array-face ((t (:bold t :foreground "wheat" :weight bold)))) (cperl-hash-face ((t (:bold t :foreground "chartreuse" :weight bold)))) (cursor ((t (:background "DarkGoldenrod1")))) (diary-face ((t (:foreground "yellow")))) (erc-input-face ((t (:foreground "lightblue2")))) (erc-notice-face ((t (:foreground "lightyellow3")))) (fixed-pitch ((t (:family "courier")))) (font-latex-bold-face ((t (:bold t :foreground "DarkOliveGreen" :weight bold)))) (font-latex-italic-face ((t (:italic t :foreground "DarkOliveGreen" :slant italic)))) (font-latex-math-face ((t (:foreground "burlywood")))) (font-latex-sedate-face ((t (:foreground "LightGray")))) (font-latex-string-face ((t (:foreground "RosyBrown")))) (font-latex-warning-face ((t (:bold t :foreground "Red" :weight bold)))) (font-lock-builtin-face ((t (:foreground "wheat")))) (font-lock-comment-face ((t (:foreground "light steel blue")))) (font-lock-constant-face ((t (:foreground "seashell3")))) (font-lock-doc-face ((t (:foreground "plum")))) (font-lock-doc-string-face ((t (:foreground "#008000")))) (font-lock-function-name-face ((t (:foreground "thistle1")))) (font-lock-keyword-face ((t (:foreground "wheat")))) (font-lock-other-emphasized-face ((t (:bold t :foreground "gold1" :weight bold)))) (font-lock-other-type-face ((t (:bold t :foreground "gold1" :weight bold)))) (font-lock-preprocessor-face ((t (:foreground "#800080")))) (font-lock-reference-face ((t (:foreground "wheat")))) (font-lock-string-face ((t (:foreground "plum")))) (font-lock-type-face ((t (:foreground "lawn green")))) (font-lock-variable-name-face ((t (:foreground "light yellow")))) (font-lock-warning-face ((t (:foreground "plum")))) (fringe ((t (:background "#000000")))) (gnus-cite-attribution-face ((t (:italic t :slant italic)))) (gnus-cite-face-1 ((t (:foreground "light blue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "light cyan")))) (gnus-cite-face-3 ((t (:foreground "light yellow")))) (gnus-cite-face-4 ((t (:foreground "light pink")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:foreground "beige")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t :weight bold)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t :slant italic)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t :weight bold)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t :weight bold)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t :weight bold)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t :weight bold)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) (gnus-header-content-face ((t (:italic t :foreground "snow2" :slant italic)))) (gnus-header-from-face ((t (:foreground "spring green")))) (gnus-header-name-face ((t (:bold t :foreground "snow2" :weight bold)))) (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic)))) (gnus-header-subject-face ((t (:bold t :foreground "peach puff" :weight bold)))) (gnus-signature-face ((t (:italic t :slant italic)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (header-line ((t (:background "grey20" :foreground "grey90")))) (highlight ((t (:background "gray91" :foreground "firebrick")))) (highline-face ((t (:background "paleturquoise" :foreground "black")))) (holiday-face ((t (:background "chocolate4")))) (isearch ((t (:background "palevioletred2" :foreground "brown4")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:italic t :slant italic)))) (menu ((t (nil)))) (message-cited-text-face ((t (:foreground "seashell3")))) (message-header-cc-face ((t (:bold t :foreground "snow2" :weight bold)))) (message-header-name-face ((t (:bold t :foreground "snow1" :weight bold)))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) (message-header-other-face ((t (:foreground "snow2")))) (message-header-subject-face ((t (:bold t :foreground "snow2" :weight bold)))) (message-header-to-face ((t (:bold t :foreground "snow2" :weight bold)))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "misty rose")))) (modeline ((t (:foreground "white" :background "#001040" :box (:line-width -1 :style released-button))))) (modeline-buffer-id ((t (:foreground "white" :background "#001040")))) (modeline-mousable ((t (:foreground "white" :background "#001040")))) (modeline-mousable-minor-mode ((t (:foreground "white" :background "#001040")))) (mouse ((t (:background "white")))) (my-tab-face ((t (:background "SlateBlue1")))) (p4-diff-del-face ((t (:bold t :foreground "salmon" :weight bold)))) (primary-selection ((t (:background "gray91" :foreground "DodgerBlue4")))) (region ((t (:background "gray91" :foreground "DodgerBlue4")))) (scroll-bar ((t (:background "grey75")))) (secondary-selection ((t (:background "gray91" :foreground "sienna3")))) (show-paren-match-face ((t (:background "cyan3" :foreground "blue")))) (show-paren-mismatch-face ((t (:background "red" :foreground "blue")))) (tool-bar ((t (:background "grey75" :foreground "black")))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "steel blue")))) (widget-inactive-face ((t (:foreground "grey")))) (widget-single-line-field-face ((t (:background "gray85")))) (zmacs-region ((t (:background "gray91" :foreground "DodgerBlue4"))))))) (defun color-theme-xp () "Color theme by Girish Bharadwaj, created 2002-04-25. Includes custom, erc, font-lock, jde, semantic, speedbar, widget." (interactive) (color-theme-install '(color-theme-xp ((background-color . "lightyellow2") (background-mode . light) (border-color . "black") (cursor-color . "black") (foreground-color . "gray20") (mouse-color . "black")) ((help-highlight-face . underline) (list-matching-lines-face . bold) (semantic-which-function-use-color . t) (senator-eldoc-use-color . t) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "lightyellow2" :foreground "gray20" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) (bg:erc-color-face0 ((t (:background "White")))) (bg:erc-color-face1 ((t (:background "black")))) (bg:erc-color-face10 ((t (:background "lightblue1")))) (bg:erc-color-face11 ((t (:background "cyan")))) (bg:erc-color-face12 ((t (:background "blue")))) (bg:erc-color-face13 ((t (:background "deeppink")))) (bg:erc-color-face14 ((t (:background "gray50")))) (bg:erc-color-face15 ((t (:background "gray90")))) (bg:erc-color-face2 ((t (:background "blue4")))) (bg:erc-color-face3 ((t (:background "green4")))) (bg:erc-color-face4 ((t (:background "red")))) (bg:erc-color-face5 ((t (:background "brown")))) (bg:erc-color-face6 ((t (:background "purple")))) (bg:erc-color-face7 ((t (:background "orange")))) (bg:erc-color-face8 ((t (:background "yellow")))) (bg:erc-color-face9 ((t (:background "green")))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (button ((t (:underline t)))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "dark blue")))) (cursor ((t (:background "black")))) (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "gray85")))) (custom-comment-tag-face ((t (:foreground "blue4")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) (erc-action-face ((t (:bold t :weight bold)))) (erc-bold-face ((t (:bold t :weight bold)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "IndianRed")))) (erc-error-face ((t (:background "Red" :foreground "White")))) (erc-input-face ((t (:foreground "brown")))) (erc-inverse-face ((t (:background "Black" :foreground "White")))) (erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold)))) (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight bold)))) (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) (erc-underline-face ((t (:underline t)))) (fg:erc-color-face0 ((t (:foreground "White")))) (fg:erc-color-face1 ((t (:foreground "black")))) (fg:erc-color-face10 ((t (:foreground "lightblue1")))) (fg:erc-color-face11 ((t (:foreground "cyan")))) (fg:erc-color-face12 ((t (:foreground "blue")))) (fg:erc-color-face13 ((t (:foreground "deeppink")))) (fg:erc-color-face14 ((t (:foreground "gray50")))) (fg:erc-color-face15 ((t (:foreground "gray90")))) (fg:erc-color-face2 ((t (:foreground "blue4")))) (fg:erc-color-face3 ((t (:foreground "green4")))) (fg:erc-color-face4 ((t (:foreground "red")))) (fg:erc-color-face5 ((t (:foreground "brown")))) (fg:erc-color-face6 ((t (:foreground "purple")))) (fg:erc-color-face7 ((t (:foreground "orange")))) (fg:erc-color-face8 ((t (:foreground "yellow")))) (fg:erc-color-face9 ((t (:foreground "green")))) (fixed-pitch ((t (:family "courier")))) (font-lock-builtin-face ((t (:foreground "magenta3" :underline t :height 0.9)))) (font-lock-comment-face ((t (:italic t :foreground "gray60" :slant oblique :height 0.9)))) (font-lock-constant-face ((t (:bold t :foreground "medium purple" :weight bold :height 0.9)))) (font-lock-function-name-face ((t (:bold t :foreground "black" :weight bold)))) (font-lock-keyword-face ((t (:bold t :foreground "blue" :weight bold)))) (font-lock-string-face ((t (:foreground "red" :height 0.9)))) (font-lock-type-face ((t (:foreground "Royalblue")))) (font-lock-variable-name-face ((t (:bold t :foreground "maroon" :weight bold :height 0.9)))) (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) (fringe ((t (:background "dodgerblue")))) (header-line ((t (:underline "red" :overline "red" :background "grey90" :foreground "grey20" :box nil)))) (highlight ((t (:background "darkseagreen2")))) (isearch ((t (:background "magenta2" :foreground "lightskyblue1")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) (italic ((t (:italic t :slant italic)))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) (jde-java-font-lock-api-face ((t (:foreground "dark goldenrod")))) (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) (jde-java-font-lock-code-face ((t (nil)))) (jde-java-font-lock-constant-face ((t (:foreground "CadetBlue")))) (jde-java-font-lock-doc-tag-face ((t (:foreground "green4")))) (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) (jde-java-font-lock-link-face ((t (:foreground "cadetblue" :underline t :slant normal)))) (jde-java-font-lock-modifier-face ((t (:foreground "Orchid")))) (jde-java-font-lock-number-face ((t (:foreground "RosyBrown")))) (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) (jde-java-font-lock-package-face ((t (:foreground "blue3")))) (jde-java-font-lock-pre-face ((t (nil)))) (jde-java-font-lock-underline-face ((t (:underline t)))) (menu ((t (nil)))) (minibuffer-prompt ((t (:foreground "dark blue")))) (modeline ((t (:background "dodgerblue" :foreground "black" :overline "red" :underline "red")))) (modeline-buffer-id ((t (:background "dodgerblue" :foreground "black")))) (modeline-mousable ((t (:background "dodgerblue" :foreground "black")))) (modeline-mousable-minor-mode ((t (:background "dodgerblue" :foreground "black")))) (mode-line-inactive ((t (:italic t :underline "red" :overline "red" :background "white" :foreground "cadetblue" :box (:line-width -1 :color "grey75") :slant oblique :weight light)))) (mouse ((t (:background "black")))) (primary-selection ((t (:background "lightgoldenrod2")))) (region ((t (:background "lightgoldenrod2")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "yellow")))) (semantic-dirty-token-face ((t (:background "lightyellow")))) (semantic-unmatched-syntax-face ((t (:underline "red")))) (senator-intangible-face ((t (:foreground "gray25")))) (senator-momentary-highlight-face ((t (:background "gray70")))) (senator-read-only-face ((t (:background "#CCBBBB")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-tag-face ((t (:foreground "brown")))) (template-message-face ((t (:bold t :weight bold)))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85")))) (zmacs-region ((t (:background "lightgoldenrod2"))))))) (defun color-theme-gray30 () "Color theme by Girish Bharadwaj, created 2002-04-22." (interactive) (color-theme-install '(color-theme-gray30 ((background-color . "grey30") (background-mode . dark) (border-color . "black") (cursor-color . "black") (foreground-color . "gainsboro") (mouse-color . "black")) ((help-highlight-face . underline) (list-matching-lines-face . bold) (semantic-which-function-use-color . t) (senator-eldoc-use-color . t) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "grey30" :foreground "gainsboro" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-courier new")))) (bg:erc-color-face0 ((t (:background "White")))) (bg:erc-color-face1 ((t (:background "black")))) (bg:erc-color-face10 ((t (:background "lightblue1")))) (bg:erc-color-face11 ((t (:background "cyan")))) (bg:erc-color-face12 ((t (:background "blue")))) (bg:erc-color-face13 ((t (:background "deeppink")))) (bg:erc-color-face14 ((t (:background "gray50")))) (bg:erc-color-face15 ((t (:background "gray90")))) (bg:erc-color-face2 ((t (:background "blue4")))) (bg:erc-color-face3 ((t (:background "green4")))) (bg:erc-color-face4 ((t (:background "red")))) (bg:erc-color-face5 ((t (:background "brown")))) (bg:erc-color-face6 ((t (:background "purple")))) (bg:erc-color-face7 ((t (:background "orange")))) (bg:erc-color-face8 ((t (:background "yellow")))) (bg:erc-color-face9 ((t (:background "green")))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (button ((t (:underline t)))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cursor ((t (:background "black")))) (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "dim gray")))) (custom-comment-tag-face ((t (:foreground "gray80")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) (custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.2)))) (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.2)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "lime green")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.2)))) (erc-action-face ((t (:bold t :weight bold)))) (erc-bold-face ((t (:bold t :weight bold)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "IndianRed")))) (erc-error-face ((t (:background "Red" :foreground "White")))) (erc-input-face ((t (:foreground "brown")))) (erc-inverse-face ((t (:background "Black" :foreground "White")))) (erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold)))) (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight bold)))) (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) (erc-underline-face ((t (:underline t)))) (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) (eshell-ls-directory-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) (eshell-ls-executable-face ((t (:bold t :foreground "Green" :weight bold)))) (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) (eshell-ls-product-face ((t (:foreground "LightSalmon")))) (eshell-ls-readonly-face ((t (:foreground "Pink")))) (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) (eshell-ls-symlink-face ((t (:bold t :foreground "Cyan" :weight bold)))) (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) (fg:erc-color-face0 ((t (:foreground "White")))) (fg:erc-color-face1 ((t (:foreground "black")))) (fg:erc-color-face10 ((t (:foreground "lightblue1")))) (fg:erc-color-face11 ((t (:foreground "cyan")))) (fg:erc-color-face12 ((t (:foreground "blue")))) (fg:erc-color-face13 ((t (:foreground "deeppink")))) (fg:erc-color-face14 ((t (:foreground "gray50")))) (fg:erc-color-face15 ((t (:foreground "gray90")))) (fg:erc-color-face2 ((t (:foreground "blue4")))) (fg:erc-color-face3 ((t (:foreground "green4")))) (fg:erc-color-face4 ((t (:foreground "red")))) (fg:erc-color-face5 ((t (:foreground "brown")))) (fg:erc-color-face6 ((t (:foreground "purple")))) (fg:erc-color-face7 ((t (:foreground "orange")))) (fg:erc-color-face8 ((t (:foreground "yellow")))) (fg:erc-color-face9 ((t (:foreground "green")))) (fixed-pitch ((t (:family "courier")))) (font-lock-builtin-face ((t (:foreground "LightSkyBlue" :underline t)))) (font-lock-comment-face ((t (:italic t :foreground "lightgreen" :slant oblique)))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-function-name-face ((t (:bold t :foreground "DodgerBlue" :weight bold :height 1.05)))) (font-lock-keyword-face ((t (:foreground "LightPink" :height 1.05)))) (font-lock-string-face ((t (:foreground "LightSalmon")))) (font-lock-type-face ((t (:foreground "yellow" :height 1.05)))) (font-lock-variable-name-face ((t (:foreground "gold")))) (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) (fringe ((t (:background "grey10")))) (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) (highlight ((t (:background "darkolivegreen")))) (isearch ((t (:background "palevioletred2" :foreground "brown4")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:italic t :slant italic)))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) (jde-java-font-lock-code-face ((t (nil)))) (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) (jde-java-font-lock-link-face ((t (:foreground "cadetblue" :underline t :slant normal)))) (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) (jde-java-font-lock-pre-face ((t (nil)))) (jde-java-font-lock-underline-face ((t (:underline t)))) (menu ((t (nil)))) (minibuffer-prompt ((t (:foreground "cyan")))) (mode-line ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (mode-line-inactive ((t (:background "grey30" :foreground "grey80" :box (:line-width -1 :color "grey40" :style nil) :weight light)))) (mouse ((t (:background "black")))) (primary-selection ((t (:background "blue3")))) (region ((t (:background "blue3")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "SkyBlue4")))) (semantic-dirty-token-face ((t (:background "lightyellow")))) (semantic-unmatched-syntax-face ((t (:underline "red")))) (senator-intangible-face ((t (:foreground "gray75")))) (senator-momentary-highlight-face ((t (:background "gray30")))) (senator-read-only-face ((t (:background "#664444")))) (show-paren-match-face ((t (:background "steelblue3")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (speedbar-button-face ((t (:foreground "green3")))) (speedbar-directory-face ((t (:foreground "light blue")))) (speedbar-file-face ((t (:foreground "cyan")))) (speedbar-highlight-face ((t (:background "sea green")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-tag-face ((t (:foreground "yellow")))) (template-message-face ((t (:bold t :weight bold)))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray")))) (zmacs-region ((t (:background "blue3"))))))) (defun color-theme-dark-green () "Color theme by ces93, created 2002-03-30." (interactive) (color-theme-install '(color-theme-dark-green ((background-mode . light) (background-toolbar-color . "#e79ddf7ddf7d") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#8e3886178617") (top-toolbar-shadow-color . "#ffffffffffff")) nil (default ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (border-glyph ((t (nil)))) (fringe ((t (nil)))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (:background "#ffffff" :foreground "#000000")))) (highlight ((t (:background "gray" :foreground "darkred")))) (isearch ((t (:background "LightSlateGray" :foreground "red")))) (italic ((t (:italic t)))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68")))) (mode-line ((t (:background "LightSlateGray" :foreground "black")))) (modeline ((t (:background "LightSlateGray" :foreground "black")))) (modeline-buffer-id ((t (:background "LightSlateGray" :foreground "blue4")))) (modeline-mousable ((t (:background "LightSlateGray" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:background "LightSlateGray" :foreground "green4")))) (pointer ((t (:background "#ffffff" :foreground "#000000")))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (region ((t (:background "gray65")))) (right-margin ((t (nil)))) (rpm-spec-dir-face ((t (:foreground "green")))) (rpm-spec-doc-face ((t (:foreground "magenta")))) (rpm-spec-ghost-face ((t (:foreground "red")))) (rpm-spec-macro-face ((t (:foreground "purple")))) (rpm-spec-package-face ((t (:foreground "red")))) (rpm-spec-tag-face ((t (:foreground "blue")))) (secondary-selection ((t (:background "paleturquoise")))) (text-cursor ((t (:background "Red3" :foreground "DarkSlateGray")))) (tool-bar ((t (nil)))) (toolbar ((t (:background "#ffffff" :foreground "#000000")))) (underline ((t (:underline t)))) (vertical-divider ((t (:background "#ffffff" :foreground "#000000")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "darkorange" :foreground "black"))))))) (defun color-theme-whateveryouwant () "Color theme by Fabien Penso, created 2002-05-02." (interactive) (color-theme-install '(color-theme-whateveryouwant ((background-color . "white") (background-mode . light) (border-color . "black") (cursor-color . "black") (foreground-color . "black") (mouse-color . "black")) ((cperl-here-face . font-lock-string-face) (cperl-invalid-face . underline) (cperl-pod-face . font-lock-comment-face) (cperl-pod-head-face . font-lock-variable-name-face) (display-time-mail-face . mode-line) (gnus-article-button-face . bold) (gnus-article-mouse-face . highlight) (gnus-carpal-button-face . bold) (gnus-carpal-header-face . bold-italic) (gnus-cite-attribution-face . gnus-cite-attribution-face) (gnus-mouse-face . highlight) (gnus-selected-tree-face . modeline) (gnus-signature-face . gnus-signature-face) (gnus-summary-selected-face . gnus-summary-selected-face) (gnus-treat-display-xface . head) (help-highlight-face . underline) (ispell-highlight-face . flyspell-incorrect-face) (list-matching-lines-face . bold) (sgml-set-face . t) (view-highlight-face . highlight) (widget-mouse-face . highlight) (x-face-mouse-face . highlight)) (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) (Info-title-1-face ((t (:bold t :weight bold :height 1.728 :family "helv")))) (Info-title-2-face ((t (:bold t :weight bold :height 1.44 :family "helv")))) (Info-title-3-face ((t (:bold t :weight bold :height 1.2 :family "helv")))) (Info-title-4-face ((t (:bold t :weight bold :family "helv")))) (antlr-font-lock-keyword-face ((t (:bold t :foreground "black" :weight bold)))) (antlr-font-lock-literal-face ((t (:bold t :foreground "brown4" :weight bold)))) (antlr-font-lock-ruledef-face ((t (:bold t :foreground "blue" :weight bold)))) (antlr-font-lock-ruleref-face ((t (:foreground "blue4")))) (antlr-font-lock-tokendef-face ((t (:bold t :foreground "blue" :weight bold)))) (antlr-font-lock-tokenref-face ((t (:foreground "orange4")))) (bbdb-company ((t (:italic t :slant italic)))) (bbdb-field-name ((t (:bold t :foreground "gray40" :weight bold)))) (bbdb-field-value ((t (nil)))) (bbdb-name ((t (:underline t)))) (bold ((t (:bold t :foreground "gray40" :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (calendar-today-face ((t (:underline t)))) (change-log-acknowledgement-face ((t (:foreground "Firebrick")))) (change-log-conditionals-face ((t (:foreground "DarkGoldenrod")))) (change-log-date-face ((t (:foreground "RosyBrown")))) (change-log-email-face ((t (:foreground "DarkGoldenrod")))) (change-log-file-face ((t (:foreground "Blue")))) (change-log-function-face ((t (:foreground "DarkGoldenrod")))) (change-log-list-face ((t (:foreground "Purple")))) (change-log-name-face ((t (:foreground "CadetBlue")))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "dark blue")))) (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (cursor ((t (:background "black")))) (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "gray85")))) (custom-comment-tag-face ((t (:foreground "blue4")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:bold t :weight bold :height 1.2 :family "helv")))) (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) (custom-group-tag-face-1 ((t (:bold t :foreground "red" :weight bold :height 1.2 :family "helv")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2 :family "helv")))) (cvs-filename-face ((t (:foreground "blue4")))) (cvs-handled-face ((t (:foreground "pink")))) (cvs-header-face ((t (:bold t :foreground "blue4" :weight bold)))) (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) (cvs-msg-face ((t (:italic t :slant italic)))) (cvs-need-action-face ((t (:foreground "orange")))) (cvs-unknown-face ((t (:foreground "red")))) (diary-face ((t (:foreground "red")))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-context-face ((t (:foreground "grey50")))) (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) (diff-function-face ((t (:foreground "grey50")))) (diff-header-face ((t (:background "grey85")))) (diff-hunk-header-face ((t (:background "grey85")))) (diff-index-face ((t (:bold t :background "grey70" :weight bold)))) (diff-nonexistent-face ((t (:bold t :background "grey70" :weight bold)))) (diff-removed-face ((t (nil)))) (dired-face-boring ((t (:foreground "RosyBrown")))) (dired-face-directory ((t (:foreground "Blue")))) (dired-face-executable ((t (nil)))) (dired-face-flagged ((t (:bold t :foreground "Red" :weight bold)))) (dired-face-marked ((t (:bold t :foreground "Red" :weight bold)))) (dired-face-permissions ((t (nil)))) (dired-face-setuid ((t (nil)))) (dired-face-socket ((t (nil)))) (dired-face-symlink ((t (:foreground "Purple")))) (ebrowse-default-face ((t (nil)))) (ebrowse-file-name-face ((t (:italic t :slant italic)))) (ebrowse-member-attribute-face ((t (:foreground "red")))) (ebrowse-member-class-face ((t (:foreground "purple")))) (ebrowse-progress-face ((t (:background "blue")))) (ebrowse-root-class-face ((t (:bold t :foreground "blue" :weight bold)))) (ebrowse-tree-mark-face ((t (:foreground "red")))) (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) (erc-action-face ((t (:bold t :weight bold)))) (erc-bold-face ((t (:bold t :weight bold)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "LightSalmon")))) (erc-error-face ((t (:bold t :foreground "IndianRed" :weight bold)))) (erc-input-face ((t (:foreground "Beige")))) (erc-inverse-face ((t (:background "wheat" :foreground "darkslategrey")))) (erc-notice-face ((t (:foreground "MediumAquamarine")))) (erc-pal-face ((t (:foreground "pale green")))) (erc-prompt-face ((t (:foreground "MediumAquamarine")))) (erc-underline-face ((t (:underline t)))) (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) (eshell-ls-directory-face ((t (:bold t :foreground "Blue" :weight bold)))) (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) (eshell-ls-picture-face ((t (:foreground "Violet")))) (eshell-ls-product-face ((t (:foreground "OrangeRed")))) (eshell-ls-readonly-face ((t (:foreground "Brown")))) (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan" :weight bold)))) (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) (eshell-prompt-face ((t (:bold t :foreground "#aa0000" :weight bold :width condensed :family "neep-alt")))) (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) (eshell-test-ok-face ((t (:bold t :foreground "Green" :weight bold)))) (excerpt ((t (:italic t :slant italic)))) (fixed ((t (:bold t :weight bold)))) (fixed-pitch ((t (:family "courier")))) (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) (font-latex-bold-face ((t (:bold t :foreground "DarkOliveGreen" :weight bold)))) (font-latex-italic-face ((t (:italic t :foreground "DarkOliveGreen" :slant italic)))) (font-latex-math-face ((t (:foreground "SaddleBrown")))) (font-latex-sedate-face ((t (:foreground "DimGray")))) (font-latex-string-face ((t (:foreground "RosyBrown")))) (font-latex-warning-face ((t (:bold t :foreground "Red" :weight bold)))) (font-lock-builtin-face ((t (:foreground "dodgerblue3")))) (font-lock-comment-face ((t (:foreground "#cc0000" :width semi-condensed :family "helvetica")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-doc-face ((t (:foreground "RosyBrown")))) (font-lock-doc-string-face ((t (:foreground "RosyBrown")))) (font-lock-function-name-face ((t (:bold t :foreground "navy" :weight bold :height 100)))) (font-lock-keyword-face ((t (:bold t :foreground "red4" :weight bold)))) (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) (font-lock-reference-face ((t (:foreground "Orchid")))) (font-lock-string-face ((t (:foreground "navy")))) (font-lock-type-face ((t (:bold t :foreground "black" :weight bold)))) (font-lock-variable-name-face ((t (:foreground "black")))) (font-lock-warning-face ((t (:foreground "orange2")))) (fringe ((t (:background "white")))) (gnus-cite-attribution-face ((t (:italic t :slant italic)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t :weight bold)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t :slant italic)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3" :weight bold)))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3" :weight bold)))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4" :weight bold)))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4" :weight bold)))) (gnus-group-news-1-empty-face ((t (:foreground "red" :weight normal :height 120 :family "courier")))) (gnus-group-news-1-face ((t (:foreground "red" :weight normal :height 120 :family "courier")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4" :weight bold)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t :weight bold)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t :weight bold)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t :weight bold)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t :weight bold)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) (gnus-header-content-face ((t (:foreground "goldenrod" :slant normal :family "helvetica")))) (gnus-header-from-face ((t (:bold t :foreground "grey75" :weight bold :height 140 :family "helvetica")))) (gnus-header-name-face ((t (:foreground "grey75" :height 120 :family "helvetica")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue" :slant italic)))) (gnus-header-subject-face ((t (:bold t :foreground "firebrick" :weight bold :height 160 :family "helvetica")))) (gnus-picon-face ((t (:background "white" :foreground "black")))) (gnus-picon-xbm-face ((t (:background "white" :foreground "black")))) (gnus-signature-face ((t (:italic t :slant italic)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick" :weight bold)))) (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue" :slant italic)))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen" :slant italic)))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick" :slant italic)))) (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) (gnus-summary-normal-ancient-face ((t (:foreground "grey65" :height 110 :width condensed :family "neep")))) (gnus-summary-normal-read-face ((t (:foreground "grey75" :height 110 :width condensed :family "neep")))) (gnus-summary-normal-ticked-face ((t (:bold t :foreground "firebrick" :weight bold :height 110 :width condensed :family "neep")))) (gnus-summary-normal-unread-face ((t (:foreground "firebrick" :height 110 :width condensed :family "neep")))) (gnus-summary-selected-face ((t (:background "gold" :foreground "black" :box (:line-width 1 :color "yellow" :style released-button) :height 140 :width condensed :family "neep")))) (header-line ((t (:background "grey90" :foreground "grey20" :box nil)))) (hi-black-b ((t (:bold t :weight bold)))) (hi-black-hb ((t (:bold t :weight bold :height 1.67 :family "helv")))) (hi-blue ((t (:background "light blue")))) (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) (hi-green ((t (:background "green")))) (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) (hi-pink ((t (:background "pink")))) (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) (hi-yellow ((t (:background "yellow")))) (highlight ((t (:background "black" :foreground "white")))) (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) (highlight-changes-face ((t (:foreground "red")))) (highline-face ((t (:background "gray80")))) (holiday-face ((t (:background "pink")))) (idlwave-help-link-face ((t (:foreground "Blue")))) (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) (info-header-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) (info-header-xref ((t (:bold t :foreground "magenta4" :weight bold)))) (info-menu-5 ((t (:foreground "red1")))) (info-menu-header ((t (:bold t :weight bold :family "helv")))) (info-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) (info-xref ((t (:bold t :foreground "magenta4" :weight bold)))) (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) (italic ((t (:italic t :slant italic)))) (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) (log-view-message-face ((t (:background "grey85")))) (makefile-space-face ((t (:background "hotpink")))) (menu ((t (nil)))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "grey45" :weight normal :family "helvetica")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue" :weight bold)))) (message-header-to-face ((t (:bold t :foreground "grey60" :weight bold :height 120 :family "helvetica")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (mode-line ((t (:background "grey90" :foreground "black" :box (:line-width 1 :style none) :width condensed :family "neep")))) (modeline-buffer-id ((t (:bold t :background "grey75" :foreground "black" :box (:line-width -1 :style released-button) :weight bold)))) (modeline-mousable ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (mouse ((t (:background "black")))) (mpg123-face-cur ((t (:background "#004080" :foreground "yellow")))) (mpg123-face-slider ((t (:background "yellow" :foreground "black")))) (primary-selection ((t (:background "lightgoldenrod2")))) (reb-match-0 ((t (:background "lightblue")))) (reb-match-1 ((t (:background "aquamarine")))) (reb-match-2 ((t (:background "springgreen")))) (reb-match-3 ((t (:background "yellow")))) (region ((t (:background "#aa0000" :foreground "white")))) (scroll-bar ((t (:background "grey75")))) (secondary-selection ((t (:background "yellow")))) (sgml-comment-face ((t (:italic t :foreground "SeaGreen" :slant italic)))) (sgml-doctype-face ((t (:bold t :foreground "FireBrick" :weight bold)))) (sgml-end-tag-face ((t (:stipple nil :background "white" :foreground "SlateBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) (sgml-entity-face ((t (:stipple nil :background "SlateBlue" :foreground "Red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) (sgml-ignored-face ((t (nil)))) (sgml-ms-end-face ((t (nil)))) (sgml-ms-start-face ((t (nil)))) (sgml-pi-face ((t (:bold t :foreground "gray40" :weight bold)))) (sgml-sgml-face ((t (:bold t :foreground "gray40" :weight bold)))) (sgml-short-ref-face ((t (nil)))) (sgml-shortref-face ((t (:bold t :foreground "gray40" :weight bold)))) (sgml-start-tag-face ((t (:stipple nil :background "white" :foreground "SlateBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 116 :width normal :family "monotype-courier new")))) (sh-heredoc-face ((t (:foreground "tan")))) (show-paren-match-face ((t (:background "gray80" :foreground "black")))) (show-paren-mismatch-face ((t (:background "red" :foreground "yellow")))) (show-tabs-space-face ((t (:foreground "yellow")))) (show-tabs-tab-face ((t (:foreground "red")))) (smerge-base-face ((t (:foreground "red")))) (smerge-markers-face ((t (:background "grey85")))) (smerge-mine-face ((t (:foreground "blue")))) (smerge-other-face ((t (:foreground "darkgreen")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-tag-face ((t (:foreground "brown")))) (strokes-char-face ((t (:background "lightgray")))) (term-black ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-blackbg ((t (:stipple nil :background "black" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-blue ((t (:stipple nil :background "white" :foreground "blue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-bluebg ((t (:stipple nil :background "blue" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-bold ((t (:bold t :stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :width normal :family "adobe-courier")))) (term-cyan ((t (:stipple nil :background "white" :foreground "cyan" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-cyanbg ((t (:stipple nil :background "cyan" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-bg ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-bg-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-fg ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-fg-inv ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-green ((t (:stipple nil :background "white" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-greenbg ((t (:stipple nil :background "green" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-invisible ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-invisible-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-magenta ((t (:stipple nil :background "white" :foreground "magenta" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-magentabg ((t (:stipple nil :background "magenta" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-red ((t (:stipple nil :background "white" :foreground "red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-redbg ((t (:stipple nil :background "red" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-underline ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline t :slant normal :weight normal :width normal :family "adobe-courier")))) (term-white ((t (:stipple nil :background "white" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-whitebg ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-yellow ((t (:stipple nil :background "white" :foreground "yellow" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-yellowbg ((t (:stipple nil :background "yellow" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (tex-math-face ((t (:foreground "RosyBrown")))) (texinfo-heading-face ((t (:foreground "Blue")))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:foreground "navy" :underline t)))) (variable-pitch ((t (:family "helv")))) (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange" :weight bold)))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-search-face ((t (:background "khaki" :foreground "Black")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85")))) (woman-addition-face ((t (:foreground "orange")))) (woman-bold-face ((t (:bold t :foreground "blue" :weight bold)))) (woman-italic-face ((t (:italic t :foreground "red" :underline t :slant italic)))) (woman-unknown-face ((t (:foreground "brown")))) (zmacs-region ((t (:background "lightgoldenrod2"))))))) (defun color-theme-bharadwaj-slate () "Color theme by Girish Bharadwaj, created 2002-05-06." (interactive) (color-theme-install '(color-theme-bharadwaj-slate ((background-color . "DarkSlateGray") (background-mode . dark) (border-color . "black") (cursor-color . "khaki") (foreground-color . "palegreen") (mouse-color . "black")) ((display-time-mail-face . mode-line) (gnus-article-button-face . bold) (gnus-article-mouse-face . highlight) (gnus-mouse-face . highlight) (help-highlight-face . underline) (ibuffer-deletion-face . font-lock-type-face) (ibuffer-filter-group-name-face . bold) (ibuffer-marked-face . font-lock-warning-face) (ibuffer-title-face . font-lock-type-face) (list-matching-lines-buffer-name-face . underline) (list-matching-lines-face . bold) (semantic-which-function-use-color . t) (senator-eldoc-use-color . t) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "DarkSlateGray" :foreground "palegreen" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida sans typewriter")))) (bg:erc-color-face0 ((t (:background "White")))) (bg:erc-color-face1 ((t (:background "black")))) (bg:erc-color-face10 ((t (:background "lightblue1")))) (bg:erc-color-face11 ((t (:background "cyan")))) (bg:erc-color-face12 ((t (:background "blue")))) (bg:erc-color-face13 ((t (:background "deeppink")))) (bg:erc-color-face14 ((t (:background "gray50")))) (bg:erc-color-face15 ((t (:background "gray90")))) (bg:erc-color-face2 ((t (:background "blue4")))) (bg:erc-color-face3 ((t (:background "green4")))) (bg:erc-color-face4 ((t (:background "red")))) (bg:erc-color-face5 ((t (:background "brown")))) (bg:erc-color-face6 ((t (:background "purple")))) (bg:erc-color-face7 ((t (:background "orange")))) (bg:erc-color-face8 ((t (:background "yellow")))) (bg:erc-color-face9 ((t (:background "green")))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (button ((t (:underline t)))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cursor ((t (:background "khaki")))) (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "dim gray")))) (custom-comment-tag-face ((t (:foreground "gray80")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) (custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.2)))) (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.2)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "lime green")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.2)))) (erc-action-face ((t (:bold t :box (:line-width 2 :color "grey75") :weight bold)))) (erc-bold-face ((t (:bold t :weight bold)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "IndianRed")))) (erc-error-face ((t (:background "Red" :foreground "White")))) (erc-input-face ((t (:foreground "lightblue")))) (erc-inverse-face ((t (:background "Black" :foreground "White")))) (erc-notice-face ((t (:bold t :foreground "dodgerblue" :weight bold)))) (erc-prompt-face ((t (:bold t :background "black" :foreground "white" :weight bold)))) (erc-timestamp-face ((t (:bold t :foreground "green" :weight bold)))) (erc-underline-face ((t (:underline t)))) (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) (eshell-ls-backup-face ((t (:foreground "LightSalmon")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) (eshell-ls-directory-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) (eshell-ls-executable-face ((t (:bold t :foreground "Green" :weight bold)))) (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) (eshell-ls-product-face ((t (:foreground "LightSalmon")))) (eshell-ls-readonly-face ((t (:foreground "Pink")))) (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) (eshell-ls-symlink-face ((t (:bold t :foreground "Cyan" :weight bold)))) (eshell-ls-unreadable-face ((t (:foreground "DarkGrey")))) (eshell-prompt-face ((t (:bold t :foreground "Pink" :weight bold)))) (fg:erc-color-face0 ((t (:foreground "White")))) (fg:erc-color-face1 ((t (:foreground "black")))) (fg:erc-color-face10 ((t (:foreground "lightblue1")))) (fg:erc-color-face11 ((t (:foreground "cyan")))) (fg:erc-color-face12 ((t (:foreground "blue")))) (fg:erc-color-face13 ((t (:foreground "deeppink")))) (fg:erc-color-face14 ((t (:foreground "gray50")))) (fg:erc-color-face15 ((t (:foreground "gray90")))) (fg:erc-color-face2 ((t (:foreground "blue4")))) (fg:erc-color-face3 ((t (:foreground "green4")))) (fg:erc-color-face4 ((t (:foreground "red")))) (fg:erc-color-face5 ((t (:foreground "brown")))) (fg:erc-color-face6 ((t (:foreground "purple")))) (fg:erc-color-face7 ((t (:foreground "orange")))) (fg:erc-color-face8 ((t (:foreground "yellow")))) (fg:erc-color-face9 ((t (:foreground "green")))) (fixed-pitch ((t (:family "courier")))) (font-lock-builtin-face ((t (:bold t :foreground "pink" :weight bold :height 1.1)))) (font-lock-comment-face ((t (:foreground "violet" :height 1.0)))) (font-lock-constant-face ((t (:bold t :foreground "tomato" :weight bold :height 1.0)))) (font-lock-function-name-face ((t (:bold t :foreground "DodgerBlue" :weight bold)))) (font-lock-keyword-face ((t (:bold t :foreground "turquoise" :weight bold)))) (font-lock-preprocessor-face ((t (:bold t :foreground "tomato" :weight bold :height 1.0)))) (font-lock-reference-face ((t (:bold t :foreground "pink" :weight bold :height 1.1)))) (font-lock-string-face ((t (:foreground "red" :height 1.0)))) (font-lock-type-face ((t (:foreground "lightblue3")))) (font-lock-variable-name-face ((t (:bold t :foreground "gray" :weight bold :height 1.0)))) (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) (fringe ((t (:background "DarkSlateGray")))) (gnus-cite-attribution-face ((t (:italic t :slant italic)))) (gnus-cite-face-1 ((t (:foreground "light blue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "light cyan")))) (gnus-cite-face-3 ((t (:foreground "light yellow")))) (gnus-cite-face-4 ((t (:foreground "light pink")))) (gnus-cite-face-5 ((t (:foreground "pale green")))) (gnus-cite-face-6 ((t (:foreground "beige")))) (gnus-cite-face-7 ((t (:foreground "orange")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t :weight bold)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t :slant italic)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) (gnus-group-mail-1-empty-face ((t (:foreground "aquamarine1")))) (gnus-group-mail-1-face ((t (:bold t :foreground "aquamarine1" :weight bold)))) (gnus-group-mail-2-empty-face ((t (:foreground "aquamarine2")))) (gnus-group-mail-2-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) (gnus-group-mail-3-empty-face ((t (:foreground "aquamarine3")))) (gnus-group-mail-3-face ((t (:bold t :foreground "aquamarine3" :weight bold)))) (gnus-group-mail-low-empty-face ((t (:foreground "aquamarine4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine4" :weight bold)))) (gnus-group-news-1-empty-face ((t (:foreground "PaleTurquoise")))) (gnus-group-news-1-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) (gnus-group-news-2-empty-face ((t (:foreground "turquoise")))) (gnus-group-news-2-face ((t (:bold t :foreground "turquoise" :weight bold)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t :weight bold)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t :weight bold)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t :weight bold)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t :weight bold)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) (gnus-header-content-face ((t (:italic t :foreground "forest green" :slant italic)))) (gnus-header-from-face ((t (:foreground "spring green")))) (gnus-header-name-face ((t (:foreground "SeaGreen")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic)))) (gnus-header-subject-face ((t (:foreground "SeaGreen3")))) (gnus-signature-face ((t (:italic t :slant italic)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "SkyBlue" :weight bold)))) (gnus-summary-high-read-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "pink" :weight bold)))) (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "SkyBlue" :slant italic)))) (gnus-summary-low-read-face ((t (:italic t :foreground "PaleGreen" :slant italic)))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) (gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) (gnus-summary-normal-read-face ((t (:foreground "PaleGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "pink")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (header-line ((t (:underline "blueviolet" :overline "blueviolet" :box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) (highlight ((t (:background "darkolivegreen")))) (html-helper-bold-face ((t (:bold t :foreground "wheat" :weight bold)))) (html-helper-italic-face ((t (:italic t :foreground "spring green" :slant italic)))) (html-helper-underline-face ((t (:foreground "cornsilk" :underline t)))) (html-tag-face ((t (:bold t :foreground "deep sky blue" :weight bold)))) (info-menu-6 ((t (nil)))) (isearch ((t (:background "palevioletred2" :foreground "brown4")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:italic t :slant italic)))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) (jde-java-font-lock-code-face ((t (nil)))) (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) (jde-java-font-lock-pre-face ((t (nil)))) (jde-java-font-lock-underline-face ((t (:underline t)))) (menu ((t (nil)))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "green4" :weight bold)))) (message-header-name-face ((t (:foreground "DarkGreen")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "yellow" :slant italic :weight bold)))) (message-header-other-face ((t (:foreground "#b00000")))) (message-header-subject-face ((t (:foreground "green3")))) (message-header-to-face ((t (:bold t :foreground "green2" :weight bold)))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "blue3")))) (minibuffer-prompt ((t (:foreground "cyan")))) (mode-line ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) (mode-line-inactive ((t (:italic t :underline "blueviolet" :overline "blueviolet" :background "white" :foreground "cadetblue" :box (:line-width -1 :color "grey75") :slant oblique :weight light)))) (modeline ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) (modeline-buffer-id ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) (modeline-mousable ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) (modeline-mousable-minor-mode ((t (:background "Darkslategray" :foreground "white" :box (:line-width -1 :style released-button) :overline "blueviolet" :underline "blueviolet")))) (mouse ((t (:background "black")))) (primary-selection ((t (:background "dimgray")))) (region ((t (:background "dimgray")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "SkyBlue4")))) (semantic-dirty-token-face ((t (:background "lightyellow")))) (semantic-unmatched-syntax-face ((t (:underline "red")))) (senator-intangible-face ((t (:foreground "gray75")))) (senator-momentary-highlight-face ((t (:background "gray30")))) (senator-read-only-face ((t (:background "#664444")))) (show-paren-match-face ((t (:bold t :foreground "lightblue" :weight bold :height 1.1)))) (show-paren-mismatch-face ((t (:bold t :foreground "red" :weight bold :height 1.1)))) (show-tabs-space-face ((t (:foreground "yellow")))) (show-tabs-tab-face ((t (:foreground "red")))) (speedbar-button-face ((t (:foreground "green3")))) (speedbar-directory-face ((t (:foreground "light blue")))) (speedbar-file-face ((t (:foreground "cyan")))) (speedbar-highlight-face ((t (:background "sea green")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-tag-face ((t (:foreground "yellow")))) (template-message-face ((t (:bold t :weight bold)))) (term-black ((t (:foreground "black")))) (term-blackbg ((t (:background "black")))) (term-blue ((t (:foreground "blue")))) (term-bluebg ((t (:background "blue")))) (term-bold ((t (:bold t :weight bold)))) (term-cyan ((t (:foreground "cyan")))) (term-cyanbg ((t (:background "cyan")))) (term-default ((t (:stipple nil :background "DarkSlateGray" :foreground "palegreen" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "outline-lucida sans typewriter")))) (term-default-bg ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-default-fg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-green ((t (:foreground "green")))) (term-greenbg ((t (:background "green")))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-magenta ((t (:foreground "magenta")))) (term-magentabg ((t (:background "magenta")))) (term-red ((t (:foreground "red")))) (term-redbg ((t (:background "red")))) (term-underline ((t (:underline t)))) (term-white ((t (:foreground "white")))) (term-whitebg ((t (:background "white")))) (term-yellow ((t (:foreground "yellow")))) (term-yellowbg ((t (:background "yellow")))) (tool-bar ((t (:background "DarkSlateGray" :foreground "White" :box (:line-width 1 :color "blue"))))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray")))) (zmacs-region ((t (:background "dimgray"))))))) (defun color-theme-lethe () "Color theme by Ivica Loncar, created 2002-08-02. Some additional X resources as suggested by the author: Emacs*menubar.Foreground: Yellow Emacs*menubar.Background: #1a2b3c Emacs*menubar.topShadowColor: gray Emacs*menubar.bottomShadowColor: dimgray Some fonts I really like (note: this fonts are not highly available): Emacs.default.attributeFont: -letl-*-medium-r-*-*-*-*-*-*-*-*-iso8859-2 Emacs*menubar*Font: -etl-fixed-medium-r-normal--14-*-*-*-*-*-iso8859-1 Mouse fix: Emacs*dialog*XmPushButton.translations:#override\n\ : Arm()\n\ ,: Activate()\ Disarm()\n\ (2+): MultiArm()\n\ (2+): MultiActivate()\n\ : Activate()\ Disarm()\n\ osfSelect: ArmAndActivate()\n\ osfActivate: ArmAndActivate()\n\ osfHelp: Help()\n\ ~Shift ~Meta ~Alt Return: ArmAndActivate()\n\ : Enter()\n\ : Leave()\n Bonus: do not use 3D modeline." (interactive) (color-theme-install '(color-theme-lethe ((background-color . "black") (background-mode . dark) (background-toolbar-color . "#000000000000") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "red") (cursor-color . "red") (foreground-color . "peachpuff") (mouse-color . "red") (top-toolbar-shadow-color . "#f5f5f5f5f5f5")) ((buffers-tab-face . buffers-tab) (cscope-use-face . t) (gnus-mouse-face . highlight)) (default ((t (nil)))) (bg:erc-color-face0 ((t (:background "White")))) (bg:erc-color-face1 ((t (nil)))) (bg:erc-color-face10 ((t (:background "lightblue1")))) (bg:erc-color-face11 ((t (:background "cyan")))) (bg:erc-color-face12 ((t (:background "blue")))) (bg:erc-color-face13 ((t (:background "deeppink")))) (bg:erc-color-face14 ((t (:background "gray50")))) (bg:erc-color-face15 ((t (:background "gray90")))) (bg:erc-color-face2 ((t (:background "blue4")))) (bg:erc-color-face3 ((t (:background "green4")))) (bg:erc-color-face4 ((t (:background "red")))) (bg:erc-color-face5 ((t (:background "brown")))) (bg:erc-color-face6 ((t (:background "purple")))) (bg:erc-color-face7 ((t (:background "orange")))) (bg:erc-color-face8 ((t (:background "yellow")))) (bg:erc-color-face9 ((t (:background "green")))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (border ((t (nil)))) (border-glyph ((t (nil)))) (buffers-tab ((t (:bold t :foreground "red")))) (button ((t (:underline t)))) (calendar-today-face ((t (:underline t)))) (comint-highlight-input ((t (:bold t)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue")))) (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red")))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (cscope-file-face ((t (:foreground "blue")))) (cscope-function-face ((t (:foreground "magenta")))) (cscope-line-face ((t (:foreground "green")))) (cscope-line-number-face ((t (:foreground "red")))) (cscope-mouse-face ((t (:background "blue" :foreground "white")))) (cursor ((t (nil)))) (custom-button-face ((t (nil)))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black")))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "dim gray")))) (custom-comment-tag-face ((t (:foreground "gray80")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t)))) (custom-variable-tag-face ((t (:underline t :foreground "blue")))) (cyan ((t (:foreground "cyan")))) (diary-face ((t (:foreground "red")))) (dired-face-boring ((t (:foreground "Gray65")))) (dired-face-directory ((t (:bold t)))) (dired-face-executable ((t (:foreground "SeaGreen")))) (dired-face-flagged ((t (:background "LightSlateGray")))) (dired-face-marked ((t (:background "PaleVioletRed")))) (dired-face-permissions ((t (:background "grey75" :foreground "black")))) (dired-face-setuid ((t (:foreground "Red")))) (dired-face-socket ((t (:foreground "magenta")))) (dired-face-symlink ((t (:foreground "cyan")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "red")))) (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) (erc-action-face ((t (:bold t)))) (erc-bold-face ((t (:bold t)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "IndianRed")))) (erc-error-face ((t (:background "Red" :foreground "White")))) (erc-input-face ((t (:foreground "brown")))) (erc-inverse-face ((t (:background "Black" :foreground "White")))) (erc-notice-face ((t (:bold t :foreground "SlateBlue")))) (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black")))) (erc-timestamp-face ((t (:bold t :foreground "green")))) (erc-underline-face ((t (:underline t)))) (eshell-ls-archive-face ((t (:bold t :foreground "Orchid")))) (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed")))) (eshell-ls-directory-face ((t (:bold t :foreground "Blue")))) (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen")))) (eshell-ls-missing-face ((t (:bold t :foreground "Red")))) (eshell-ls-product-face ((t (:foreground "OrangeRed")))) (eshell-ls-readonly-face ((t (:foreground "Brown")))) (eshell-ls-special-face ((t (:bold t :foreground "Magenta")))) (eshell-ls-symlink-face ((t (:bold t :foreground "DarkCyan")))) (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) (eshell-prompt-face ((t (:bold t :foreground "Red")))) (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed")))) (eshell-test-ok-face ((t (:bold t :foreground "Green")))) (excerpt ((t (:italic t)))) (fg:erc-color-face0 ((t (:foreground "White")))) (fg:erc-color-face1 ((t (:foreground "black")))) (fg:erc-color-face10 ((t (:foreground "lightblue1")))) (fg:erc-color-face11 ((t (:foreground "cyan")))) (fg:erc-color-face12 ((t (:foreground "blue")))) (fg:erc-color-face13 ((t (:foreground "deeppink")))) (fg:erc-color-face14 ((t (:foreground "gray50")))) (fg:erc-color-face15 ((t (:foreground "gray90")))) (fg:erc-color-face2 ((t (:foreground "blue4")))) (fg:erc-color-face3 ((t (:foreground "green4")))) (fg:erc-color-face4 ((t (:foreground "red")))) (fg:erc-color-face5 ((t (:foreground "brown")))) (fg:erc-color-face6 ((t (:foreground "purple")))) (fg:erc-color-face7 ((t (:foreground "orange")))) (fg:erc-color-face8 ((t (:foreground "yellow")))) (fg:erc-color-face9 ((t (:foreground "green")))) (fixed ((t (:bold t)))) (fixed-pitch ((t (:size "16")))) (flyspell-duplicate-face ((t (:underline t :bold t :foreground "Gold3")))) (flyspell-incorrect-face ((t (:underline t :bold t :foreground "OrangeRed")))) (font-lock-builtin-face ((t (:foreground "Orchid")))) (font-lock-comment-face ((t (:bold t :foreground "cyan")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-doc-face ((t (:bold t :foreground "red")))) (font-lock-doc-string-face ((t (:bold t :foreground "red")))) (font-lock-function-name-face ((t (:bold t :foreground "white")))) (font-lock-keyword-face ((t (:bold t :foreground "yellow")))) (font-lock-preprocessor-face ((t (:bold t :foreground "blue")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (:bold t :foreground "magenta")))) (font-lock-type-face ((t (:bold t :foreground "lightgreen")))) (font-lock-variable-name-face ((t (:bold t :foreground "white")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (fringe ((t (:background "grey95")))) (gdb-arrow-face ((t (:bold t :background "yellow" :foreground "red")))) (gnus-cite-attribution-face ((t (:italic t)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-highlight-words ((t (:foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) (gnus-header-from-face ((t (:foreground "red3")))) (gnus-header-name-face ((t (:foreground "maroon")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue")))) (gnus-header-subject-face ((t (:foreground "red4")))) (gnus-picons-face ((t (:background "white" :foreground "black")))) (gnus-picons-xbm-face ((t (:background "white" :foreground "black")))) (gnus-signature-face ((t (:italic t)))) (gnus-splash-face ((t (:foreground "ForestGreen")))) (gnus-summary-cancelled-face ((t (:foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (gnus-x-face ((t (:background "white" :foreground "black")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (:size "12" :background "Gray80" :foreground "black")))) (header-line ((t (:background "grey20" :foreground "grey90")))) (highlight ((t (:bold t :background "yellow" :foreground "red")))) (highlight-changes-delete-face ((t (:underline t :foreground "red")))) (highlight-changes-face ((t (:foreground "red")))) (highline-face ((t (:background "paleturquoise")))) (holiday-face ((t (:background "pink")))) (hyper-apropos-documentation ((t (:foreground "#aaaaaa")))) (hyper-apropos-heading ((t (:bold t :foreground "#999999")))) (hyper-apropos-hyperlink ((t (:foreground "Violet")))) (hyper-apropos-major-heading ((t (:bold t :foreground "#ff0000")))) (hyper-apropos-section-heading ((t (:italic t :bold t :foreground "#33aa55")))) (hyper-apropos-warning ((t (:bold t :foreground "red")))) (info-menu-5 ((t (:underline t)))) (info-node ((t (:italic t :bold t)))) (info-xref ((t (:bold t)))) (isearch ((t (:background "paleturquoise")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (:italic t)))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) (jde-java-font-lock-bold-face ((t (:bold t)))) (jde-java-font-lock-code-face ((t (nil)))) (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) (jde-java-font-lock-italic-face ((t (:italic t)))) (jde-java-font-lock-link-face ((t (:underline t :foreground "cadetblue")))) (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) (jde-java-font-lock-pre-face ((t (nil)))) (jde-java-font-lock-underline-face ((t (:underline t)))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68")))) (magenta ((t (:foreground "magenta")))) (makefile-space-face ((t (:background "hotpink")))) (menu ((t (nil)))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:bold t :foreground "cyan")))) (message-separator-face ((t (:foreground "brown")))) (minibuffer-prompt ((t (:foreground "cyan")))) (mode-line ((t (:background "grey75" :foreground "black")))) (mode-line-inactive ((t (:background "grey30" :foreground "grey80")))) (modeline ((t (:bold t :background "red" :foreground "yellow")))) (modeline-buffer-id ((t (:bold t :background "red" :foreground "yellow")))) (modeline-mousable ((t (:background "red" :foreground "yellow")))) (modeline-mousable-minor-mode ((t (:background "red" :foreground "green4")))) (mouse ((t (nil)))) (paren-blink-off ((t (:foreground "black")))) (paren-match ((t (:bold t :background "yellow" :foreground "red")))) (paren-mismatch ((t (:background "DeepPink")))) (pointer ((t (nil)))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (region ((t (:background "gray75")))) (right-margin ((t (nil)))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "paleturquoise")))) (semantic-dirty-token-face ((t (:background "lightyellow")))) (semantic-unmatched-syntax-face ((t (nil)))) (senator-intangible-face ((t (:foreground "gray75")))) (senator-momentary-highlight-face ((t (:background "gray30")))) (senator-read-only-face ((t (:background "#664444")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:underline t :foreground "red")))) (speedbar-tag-face ((t (:foreground "brown")))) (template-message-face ((t (:bold t)))) (term-black ((t (:foreground "black")))) (term-blackbg ((t (nil)))) (term-blue ((t (:foreground "blue")))) (term-blue-bold-face ((t (:bold t :foreground "blue")))) (term-blue-face ((t (:foreground "blue")))) (term-blue-inv-face ((t (:background "blue")))) (term-blue-ul-face ((t (:underline t :foreground "blue")))) (term-bluebg ((t (:background "blue")))) (term-bold ((t (:bold t)))) (term-cyan ((t (:foreground "cyan")))) (term-cyan-bold-face ((t (:bold t :foreground "cyan")))) (term-cyan-face ((t (:foreground "cyan")))) (term-cyan-inv-face ((t (:background "cyan")))) (term-cyan-ul-face ((t (:underline t :foreground "cyan")))) (term-cyanbg ((t (:background "cyan")))) (term-default-bg ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-default-bold-face ((t (:bold t)))) (term-default-face ((t (nil)))) (term-default-fg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-default-inv-face ((t (:background "peachpuff" :foreground "black")))) (term-default-ul-face ((t (:underline t)))) (term-green ((t (:foreground "green")))) (term-green-bold-face ((t (:bold t :foreground "green")))) (term-green-face ((t (:foreground "green")))) (term-green-inv-face ((t (:background "green")))) (term-green-ul-face ((t (:underline t :foreground "green")))) (term-greenbg ((t (:background "green")))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-magenta ((t (:foreground "magenta")))) (term-magenta-bold-face ((t (:bold t :foreground "magenta")))) (term-magenta-face ((t (:foreground "magenta")))) (term-magenta-inv-face ((t (:background "magenta")))) (term-magenta-ul-face ((t (:underline t :foreground "magenta")))) (term-magentabg ((t (:background "magenta")))) (term-red ((t (:foreground "red")))) (term-red-bold-face ((t (:bold t :foreground "red")))) (term-red-face ((t (:foreground "red")))) (term-red-inv-face ((t (:background "red")))) (term-red-ul-face ((t (:underline t :foreground "red")))) (term-redbg ((t (:background "red")))) (term-underline ((t (:underline t)))) (term-white ((t (:foreground "white")))) (term-white-bold-face ((t (:bold t :foreground "white")))) (term-white-face ((t (:foreground "white")))) (term-white-inv-face ((t (nil)))) (term-white-ul-face ((t (:underline t :foreground "white")))) (term-whitebg ((t (:background "white")))) (term-yellow ((t (:foreground "yellow")))) (term-yellow-bold-face ((t (:bold t :foreground "yellow")))) (term-yellow-face ((t (:foreground "yellow")))) (term-yellow-inv-face ((t (:background "yellow")))) (term-yellow-ul-face ((t (:underline t :foreground "yellow")))) (term-yellowbg ((t (:background "yellow")))) (text-cursor ((t (:background "red" :foreground "black")))) (tool-bar ((t (:background "grey75" :foreground "black")))) (toolbar ((t (:background "Gray80" :foreground "black")))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (nil)))) (vcursor ((t (:underline t :background "cyan" :foreground "blue")))) (vertical-divider ((t (:background "Gray80" :foreground "black")))) (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red")))) (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange")))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) (vhdl-speedbar-architecture-selected-face ((t (:underline t :foreground "Blue")))) (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) (vhdl-speedbar-configuration-selected-face ((t (:underline t :foreground "DarkGoldenrod")))) (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) (vhdl-speedbar-entity-selected-face ((t (:underline t :foreground "ForestGreen")))) (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) (vhdl-speedbar-instantiation-selected-face ((t (:underline t :foreground "Brown")))) (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) (vhdl-speedbar-package-selected-face ((t (:underline t :foreground "Grey50")))) (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-search-face ((t (:background "khaki" :foreground "Black")))) (white ((t (:foreground "white")))) (widget ((t (:size "12" :background "Gray80" :foreground "black")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (nil)))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85")))) (x-face ((t (:bold t :background "wheat" :foreground "black")))) (xrdb-option-name-face ((t (:bold t :foreground "yellow")))) (xrdb-option-value-face ((t (:bold t :foreground "magenta")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "white" :foreground "black"))))))) (defun color-theme-shaman () "Color theme by shaman, created 2002-11-11." (interactive) (color-theme-install '(color-theme-shaman ((background-color . "#456345") (background-mode . dark) (background-toolbar-color . "#cf3ccf3ccf3c") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#79e77df779e7") (foreground-color . "White") (top-toolbar-shadow-color . "#f7defbeef7de")) ((buffers-tab-face . buffers-tab)) (default ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t :size "12")))) (bold-italic ((t (:italic t :bold t :size "12")))) (border-glyph ((t (nil)))) (buffers-tab ((t (:background "Gray80" :foreground "black")))) (font-lock-builtin-face ((t (:foreground "cadetblue2")))) (font-lock-comment-face ((t (:foreground "gray80")))) (font-lock-constant-face ((t (:foreground "steelblue1")))) (font-lock-doc-face ((t (:foreground "light coral")))) (font-lock-doc-string-face ((t (:foreground "light coral")))) (font-lock-function-name-face ((t (:foreground "aquamarine")))) (font-lock-keyword-face ((t (:foreground "cyan")))) (font-lock-preprocessor-face ((t (:foreground "steelblue1")))) (font-lock-reference-face ((t (:foreground "cadetblue2")))) (font-lock-string-face ((t (:foreground "tan")))) (font-lock-type-face ((t (:foreground "wheat")))) (font-lock-variable-name-face ((t (:foreground "cyan3")))) (font-lock-warning-face ((t (:bold t :size "12" :foreground "Pink")))) (fringe ((t (nil)))) (gnus-x-face ((t (:background "white" :foreground "black")))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75" :foreground "black")))) (gui-element ((t (:size "12" :background "Gray80" :foreground "black")))) (highlight ((t (:background "darkseagreen2")))) (isearch ((t (:background "paleturquoise")))) (isearch-secondary ((t (:foreground "red3")))) (italic ((t (:italic t :size "12")))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68")))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:bold t :foreground "green4")))) (message-header-name-face ((t (:foreground "DarkGreen")))) (message-header-newsgroups-face ((t (:bold t :foreground "yellow")))) (message-header-other-face ((t (:foreground "#b00000")))) (message-header-subject-face ((t (:foreground "green3")))) (message-header-to-face ((t (:bold t :foreground "green2")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "blue3")))) (mode-line ((t (:background "Gray80" :foreground "black")))) (modeline ((t (:background "Gray80" :foreground "black")))) (modeline-buffer-id ((t (:background "Gray80" :foreground "blue4")))) (modeline-mousable ((t (:background "Gray80" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:background "Gray80" :foreground "green4")))) (pointer ((t (:foreground "White")))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (region ((t (:background "gray65")))) (right-margin ((t (nil)))) (rpm-spec-dir-face ((t (:foreground "green")))) (rpm-spec-doc-face ((t (:foreground "magenta")))) (rpm-spec-ghost-face ((t (:foreground "red")))) (rpm-spec-macro-face ((t (:foreground "yellow")))) (rpm-spec-package-face ((t (:foreground "red")))) (rpm-spec-tag-face ((t (:foreground "blue")))) (rpm-spec-var-face ((t (:foreground "maroon")))) (secondary-selection ((t (:background "paleturquoise")))) (text-cursor ((t (:background "Pink" :foreground "Black")))) (tool-bar ((t (nil)))) (toolbar ((t (:background "Gray80" :foreground "black")))) (underline ((t (:underline t)))) (vertical-divider ((t (:background "Gray80" :foreground "black")))) (widget ((t (:size "12" :background "Gray80" :foreground "black")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "gray65"))))))) (defun color-theme-emacs-nw () "Follow emacs21's color-theme, with -nw getting 100% compatibility. Alex's `color-theme-emacs-21' follows emacs21's theme, but in the current scheme of things, that means that when it works on X, it won't work in -nw perfectly. The modeline and menuline will have same colors as the rest of emacs, which can be particularly disturbing when there are multiple windows. OTOH, `color-theme-emacs-nw' follows emacs21's theme but the goal is 100% -nw compatibility, and in X; we shall try for decent color scheme, and as much compability default emacs21's X as possble. Bugs to deego@gnufans.org. TODO: Try to make this theme relative to color-theme-emacs-21 rather than absolute, viz: call that first and then tweak minor stuff." (interactive) (color-theme-install '(color-theme-emacs-nw ((background-color . "white") (background-mode . light) (border-color . "black") (cursor-color . "black") (foreground-color . "black") (mouse-color . "black")) ((Man-overstrike-face . bold) (Man-underline-face . underline) (cperl-here-face . font-lock-string-face) (cperl-invalid-face . underline) (cperl-pod-face . font-lock-comment-face) (cperl-pod-head-face . font-lock-variable-name-face) (gnus-article-button-face . bold) (gnus-article-mouse-face . highlight) (gnus-cite-attribution-face . gnus-cite-attribution-face) (gnus-mouse-face . highlight) (gnus-signature-face . gnus-signature-face) (gnus-summary-selected-face . gnus-summary-selected-face) (help-highlight-face . underline) (idlwave-class-arrow-face . bold) (idlwave-shell-breakpoint-face . idlwave-shell-bp-face) (idlwave-shell-expression-face . secondary-selection) (idlwave-shell-stop-line-face . highlight) (ispell-highlight-face . highlight) (list-matching-lines-face . bold) (view-highlight-face . highlight) (viper-insert-state-cursor-color . "Green") (viper-replace-overlay-cursor-color . "Red") (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) (antlr-font-lock-keyword-face ((t (:bold t :foreground "black" :weight bold)))) (antlr-font-lock-literal-face ((t (:bold t :foreground "brown4" :weight bold)))) (antlr-font-lock-ruledef-face ((t (:bold t :foreground "blue" :weight bold)))) (antlr-font-lock-ruleref-face ((t (:foreground "blue4")))) (antlr-font-lock-tokendef-face ((t (:bold t :foreground "blue" :weight bold)))) (antlr-font-lock-tokenref-face ((t (:foreground "orange4")))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (calendar-today-face ((t (:underline t)))) (change-log-acknowledgement-face ((t (:foreground "Firebrick")))) (change-log-conditionals-face ((t (:foreground "DarkGoldenrod")))) (change-log-date-face ((t (:foreground "RosyBrown")))) (change-log-email-face ((t (:foreground "DarkGoldenrod")))) (change-log-file-face ((t (:foreground "Blue")))) (change-log-function-face ((t (:foreground "DarkGoldenrod")))) (change-log-list-face ((t (:foreground "Purple")))) (change-log-name-face ((t (:foreground "CadetBlue")))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "dark blue")))) (cperl-array-face ((t (:bold t :background "lightyellow2" :foreground "Blue" :weight bold)))) (cperl-hash-face ((t (:italic t :bold t :background "lightyellow2" :foreground "Red" :slant italic :weight bold)))) (cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) (cursor ((t (:background "black")))) (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "gray85")))) (custom-comment-tag-face ((t (:foreground "blue4")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) (custom-group-tag-face ((t (:bold t :foreground "blue" :weight bold :height 1.2)))) (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "red" :weight bold :height 1.2)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "blue" :weight bold :height 1.2)))) (cvs-filename-face ((t (:foreground "blue4")))) (cvs-handled-face ((t (:foreground "pink")))) (cvs-header-face ((t (:bold t :foreground "blue4" :weight bold)))) (cvs-marked-face ((t (:bold t :foreground "green3" :weight bold)))) (cvs-msg-face ((t (:italic t :slant italic)))) (cvs-need-action-face ((t (:foreground "orange")))) (cvs-unknown-face ((t (:foreground "red")))) (diary-face ((t (:foreground "red")))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-context-face ((t (:foreground "grey50")))) (diff-file-header-face ((t (:bold t :background "grey70" :weight bold)))) (diff-function-face ((t (:foreground "grey50")))) (diff-header-face ((t (:background "grey85")))) (diff-hunk-header-face ((t (:background "grey85")))) (diff-index-face ((t (:bold t :weight bold :background "grey70")))) (diff-nonexistent-face ((t (:bold t :weight bold :background "grey70")))) (diff-removed-face ((t (nil)))) (dired-face-boring ((t (:foreground "RosyBrown")))) (dired-face-directory ((t (:foreground "Blue")))) (dired-face-executable ((t (nil)))) (dired-face-flagged ((t (:foreground "Red" :weight bold)))) (dired-face-marked ((t (:foreground "Red" :weight bold)))) (dired-face-permissions ((t (nil)))) (dired-face-setuid ((t (nil)))) (dired-face-socket ((t (nil)))) (dired-face-symlink ((t (:foreground "Purple")))) (ebrowse-default-face ((t (nil)))) (ebrowse-file-name-face ((t (:italic t :slant italic)))) (ebrowse-member-attribute-face ((t (:foreground "red")))) (ebrowse-member-class-face ((t (:foreground "purple")))) (ebrowse-progress-face ((t (:background "blue")))) (ebrowse-root-class-face ((t (:bold t :foreground "blue" :weight bold)))) (ebrowse-tree-mark-face ((t (:foreground "red")))) (ediff-current-diff-face-A ((t (:background "pale green" :foreground "firebrick")))) (ediff-current-diff-face-Ancestor ((t (:background "VioletRed" :foreground "Black")))) (ediff-current-diff-face-B ((t (:background "Yellow" :foreground "DarkOrchid")))) (ediff-current-diff-face-C ((t (:background "Pink" :foreground "Navy")))) (ediff-even-diff-face-A ((t (:background "light grey" :foreground "Black")))) (ediff-even-diff-face-Ancestor ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-B ((t (:background "Grey" :foreground "White")))) (ediff-even-diff-face-C ((t (:background "light grey" :foreground "Black")))) (ediff-fine-diff-face-A ((t (:background "sky blue" :foreground "Navy")))) (ediff-fine-diff-face-Ancestor ((t (:background "Green" :foreground "Black")))) (ediff-fine-diff-face-B ((t (:background "cyan" :foreground "Black")))) (ediff-fine-diff-face-C ((t (:background "Turquoise" :foreground "Black")))) (ediff-odd-diff-face-A ((t (:background "Grey" :foreground "White")))) (ediff-odd-diff-face-Ancestor ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-B ((t (:background "light grey" :foreground "Black")))) (ediff-odd-diff-face-C ((t (:background "Grey" :foreground "White")))) (eshell-ls-archive-face ((t (:bold t :foreground "Orchid" :weight bold)))) (eshell-ls-backup-face ((t (:foreground "OrangeRed")))) (eshell-ls-clutter-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) (eshell-ls-directory-face ((t (:bold t :foreground "Blue" :weight bold)))) (eshell-ls-executable-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) (eshell-ls-missing-face ((t (:bold t :foreground "Red" :weight bold)))) (eshell-ls-product-face ((t (:foreground "OrangeRed")))) (eshell-ls-readonly-face ((t (:foreground "Brown")))) (eshell-ls-special-face ((t (:bold t :foreground "Magenta" :weight bold)))) (eshell-ls-symlink-face ((t (:bold t :foreground "Dark Cyan" :weight bold)))) (eshell-ls-unreadable-face ((t (:foreground "Grey30")))) (eshell-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) (eshell-test-failed-face ((t (:bold t :foreground "OrangeRed" :weight bold)))) (eshell-test-ok-face ((t (:bold t :foreground "Green" :weight bold)))) (excerpt ((t (:italic t :slant italic)))) (fixed ((t (:bold t :weight bold)))) (fixed-pitch ((t (:family "courier")))) (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) (font-lock-builtin-face ((t (:foreground "Orchid")))) (font-lock-comment-face ((t (:foreground "Firebrick")))) (font-lock-constant-face ((t (:foreground "CadetBlue")))) (font-lock-doc-face ((t (:foreground "RosyBrown")))) (font-lock-doc-string-face ((t (:foreground "RosyBrown")))) (font-lock-function-name-face ((t (:foreground "Blue")))) (font-lock-keyword-face ((t (:foreground "Purple")))) (font-lock-preprocessor-face ((t (:foreground "CadetBlue")))) (font-lock-reference-face ((t (:foreground "Orchid")))) (font-lock-string-face ((t (:foreground "RosyBrown")))) (font-lock-type-face ((t (:foreground "ForestGreen")))) (font-lock-variable-name-face ((t (:foreground "DarkGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) (fringe ((t (:background "grey95")))) (gnus-cite-attribution-face ((t (:italic t :slant italic)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t :weight bold)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t :slant italic)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3" :weight bold)))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3" :weight bold)))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4" :weight bold)))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4" :weight bold)))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4" :weight bold)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t :weight bold)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t :weight bold)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t :weight bold)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t :weight bold)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) (gnus-header-content-face ((t (:italic t :foreground "indianred4" :slant italic)))) (gnus-header-from-face ((t (:foreground "red3")))) (gnus-header-name-face ((t (:foreground "maroon")))) (gnus-header-newsgroups-face ((t (:italic t :foreground "MidnightBlue" :slant italic)))) (gnus-header-subject-face ((t (:foreground "red4")))) (gnus-signature-face ((t (:italic t :slant italic)))) (gnus-splash-face ((t (:foreground "Brown")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen" :weight bold)))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "firebrick" :weight bold)))) (gnus-summary-high-unread-face ((t (:bold t :weight bold)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue" :slant italic)))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen" :slant italic)))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick" :slant italic)))) (gnus-summary-low-unread-face ((t (:italic t :slant italic)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "firebrick")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (header-line ((t (:box (:line-width -1 :style released-button) :background "grey90" :foreground "grey20" :box nil)))) (hi-black-b ((t (:bold t :weight bold)))) (hi-black-hb ((t (:bold t :family "helv" :weight bold :height 1.67)))) (hi-blue ((t (:background "light blue")))) (hi-blue-b ((t (:bold t :foreground "blue" :weight bold)))) (hi-green ((t (:background "green")))) (hi-green-b ((t (:bold t :foreground "green" :weight bold)))) (hi-pink ((t (:background "pink")))) (hi-red-b ((t (:bold t :foreground "red" :weight bold)))) (hi-yellow ((t (:background "yellow")))) (highlight ((t (:background "darkseagreen2")))) (highlight-changes-delete-face ((t (:foreground "red" :underline t)))) (highlight-changes-face ((t (:foreground "red")))) (holiday-face ((t (:background "pink")))) (idlwave-help-link-face ((t (:foreground "Blue")))) (idlwave-shell-bp-face ((t (:background "Pink" :foreground "Black")))) (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "brown")))) (info-header-xref ((t (:bold t :weight bold :foreground "magenta4")))) (info-menu-5 ((t (:foreground "red1")))) (info-menu-header ((t (:bold t :family "helv" :weight bold)))) (info-node ((t (:italic t :bold t :foreground "brown" :slant italic :weight bold)))) (info-xref ((t (:bold t :foreground "magenta4" :weight bold)))) (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) (italic ((t (:italic t :slant italic)))) (log-view-file-face ((t (:bold t :background "grey70" :weight bold)))) (log-view-message-face ((t (:background "grey85")))) (makefile-space-face ((t (:background "hotpink")))) (menu ((t (:background "grey50" :foreground "white" :box (:line-width -1 :style released-button))))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4" :slant italic :weight bold)))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue" :weight bold)))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue" :weight bold)))) (message-header-xheader-face ((t (:foreground "blue")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (mode-line ((t (:background "grey50" :foreground "white" :box (:line-width -1 :style released-button))))) (modeline ((t (:background "grey50" :foreground "white" :box (:line-width -1 :style released-button))))) (modeline-buffer-id ((t (:bold t :background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (modeline-mousable ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (modeline-mousable-minor-mode ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (mouse ((t (:background "black")))) (primary-selection ((t (:background "lightgoldenrod2")))) (reb-match-0 ((t (:background "lightblue")))) (reb-match-1 ((t (:background "aquamarine")))) (reb-match-2 ((t (:background "springgreen")))) (reb-match-3 ((t (:background "yellow")))) (region ((t (:background "lightgoldenrod2")))) (scroll-bar ((t (:background "grey75")))) (secondary-selection ((t (:background "yellow")))) (sh-heredoc-face ((t (:foreground "tan")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (show-tabs-space-face ((t (:foreground "yellow")))) (show-tabs-tab-face ((t (:foreground "red")))) (smerge-base-face ((t (:foreground "red")))) (smerge-markers-face ((t (:background "grey85")))) (smerge-mine-face ((t (:foreground "blue")))) (smerge-other-face ((t (:foreground "darkgreen")))) (speedbar-button-face ((t (:foreground "green4")))) (speedbar-directory-face ((t (:foreground "blue4")))) (speedbar-file-face ((t (:foreground "cyan4")))) (speedbar-highlight-face ((t (:background "green")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-tag-face ((t (:foreground "brown")))) (strokes-char-face ((t (:background "lightgray")))) (term-black ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-blackbg ((t (:stipple nil :background "black" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-blue ((t (:stipple nil :background "white" :foreground "blue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-bluebg ((t (:stipple nil :background "blue" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-bold ((t (:bold t :stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight bold :width normal :family "adobe-courier")))) (term-cyan ((t (:stipple nil :background "white" :foreground "cyan" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-cyanbg ((t (:stipple nil :background "cyan" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-bg ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-bg-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-fg ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-default-fg-inv ((t (:stipple nil :background "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-green ((t (:stipple nil :background "white" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-greenbg ((t (:stipple nil :background "green" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-invisible ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-invisible-inv ((t (:stipple nil :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-magenta ((t (:stipple nil :background "white" :foreground "magenta" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-magentabg ((t (:stipple nil :background "magenta" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-red ((t (:stipple nil :background "white" :foreground "red" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-redbg ((t (:stipple nil :background "red" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-underline ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline t :slant normal :weight normal :width normal :family "adobe-courier")))) (term-white ((t (:stipple nil :background "white" :foreground "white" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-whitebg ((t (:stipple nil :background "white" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-yellow ((t (:stipple nil :background "white" :foreground "yellow" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (term-yellowbg ((t (:stipple nil :background "yellow" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width normal :family "adobe-courier")))) (tex-math-face ((t (:foreground "RosyBrown")))) (texinfo-heading-face ((t (:foreground "Blue")))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (vcursor ((t (:background "cyan" :foreground "blue" :underline t)))) (vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) (vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) (vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) (vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) (vhdl-font-lock-prompt-face ((t (:bold t :foreground "Red" :weight bold)))) (vhdl-font-lock-reserved-words-face ((t (:bold t :foreground "Orange" :weight bold)))) (vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) (vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) (vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) (vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) (vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) (vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) (vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) (vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) (vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) (vhdl-speedbar-package-face ((t (:foreground "Grey50")))) (vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) (viper-minibuffer-emacs-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-minibuffer-insert-face ((t (:background "pink" :foreground "Black")))) (viper-minibuffer-vi-face ((t (:background "grey" :foreground "DarkGreen")))) (viper-replace-overlay-face ((t (:background "darkseagreen2" :foreground "Black")))) (viper-search-face ((t (:background "khaki" :foreground "Black")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85")))) (woman-addition-face ((t (:foreground "orange")))) (woman-bold-face ((t (:bold t :foreground "blue" :weight bold)))) (woman-italic-face ((t (:italic t :foreground "red" :underline t :slant italic)))) (woman-unknown-face ((t (:foreground "brown")))) (zmacs-region ((t (:background "lightgoldenrod2"))))))) (defun color-theme-late-night () "Color theme by Alex Schroeder, created 2003-08-07. This theme is for use late at night, with only little light in the room. The goal was to make something as dark and subtle as the text console in its default 80x25 state -- dark grey on black." (interactive) (let ((color-theme-is-cumulative t)) (color-theme-dark-erc) (color-theme-dark-gnus) ;; (color-theme-dark-diff) ;; (color-theme-dark-eshell) (color-theme-dark-info) (color-theme-dark-font-lock) (color-theme-install '(color-theme-late-night ((background-color . "#000") (background-mode . dark) (background-toolbar-color . "#000") (border-color . "#000") (bottom-toolbar-shadow-color . "#000") (cursor-color . "#888") (foreground-color . "#666") (top-toolbar-shadow-color . "#111")) (default ((t (nil)))) (bold ((t (:bold t)))) (button ((t (:bold t)))) (custom-button-face ((t (:bold t :foreground "#999")))) (fringe ((t (:background "#111" :foreground "#444")))) (header-line ((t (:background "#333" :foreground "#000")))) (highlight ((t (:background "dark slate blue" :foreground "light blue")))) (holiday-face ((t (:background "#000" :foreground "#777")))) (isearch ((t (:foreground "pink" :background "red")))) (isearch-lazy-highlight-face ((t (:foreground "red")))) (italic ((t (:bold t)))) (menu ((t (:background "#111" :foreground "#444")))) (minibuffer-prompt ((t (:foreground "555")))) (modeline ((t (:background "#111" :foreground "#444")))) (mode-line-inactive ((t (:background "#000" :foreground "#444")))) (modeline-buffer-id ((t (:background "#000" :foreground "#555")))) (modeline-mousable ((t (:background "#000" :foreground "#555")))) (modeline-mousable-minor-mode ((t (:background "#000" :foreground "#555")))) (region ((t (:background "dark cyan" :foreground "cyan")))) (secondary-selection ((t (:background "Aquamarine" :foreground "SlateBlue")))) (show-paren-match-face ((t (:foreground "white" :background "light slate blue")))) (show-paren-mismatch-face ((t (:foreground "white" :background "red")))) (tool-bar ((t (:background "#111" :foreground "#777")))) (tooltip ((t (:background "#333" :foreground "#777")))) (underline ((t (:bold t)))) (variable-pitch ((t (nil)))) (widget-button-face ((t (:bold t :foreground "#888")))) (widget-field-face ((t (:bold t :foreground "#999")))))))) (defun color-theme-clarity () "White on black color theme by Richard Wellum, created 2003-01-16." (interactive) (color-theme-install '(color-theme-clarity ((background-color . "black") (background-mode . dark) (border-color . "white") (cursor-color . "yellow") (foreground-color . "white") (mouse-color . "white")) ((CUA-mode-global-mark-cursor-color . "cyan") (CUA-mode-normal-cursor-color . "yellow") (CUA-mode-overwrite-cursor-color . "red") (CUA-mode-read-only-cursor-color . "green") (help-highlight-face . underline) (ibuffer-dired-buffer-face . font-lock-function-name-face) (ibuffer-help-buffer-face . font-lock-comment-face) (ibuffer-hidden-buffer-face . font-lock-warning-face) (ibuffer-occur-match-face . font-lock-warning-face) (ibuffer-read-only-buffer-face . font-lock-type-face) (ibuffer-special-buffer-face . font-lock-keyword-face) (ibuffer-title-face . font-lock-type-face) (list-matching-lines-face . bold) (ps-line-number-color . "black") (ps-zebra-color . 0.95) (tags-tag-face . default) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (nil)))) (CUA-global-mark-face ((t (:background "cyan" :foreground "black")))) (CUA-rectangle-face ((t (:background "maroon" :foreground "white")))) (CUA-rectangle-noselect-face ((t (:background "dimgray" :foreground "white")))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "white")))) (clearcase-dired-checkedout-face ((t (:foreground "red")))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cursor ((t (:background "yellow")))) (fixed-pitch ((t (:family "courier")))) (flash-paren-face-off ((t (nil)))) (flash-paren-face-on ((t (nil)))) (flash-paren-face-region ((t (nil)))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:foreground "OrangeRed")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-doc-face ((t (:foreground "LightSalmon")))) (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) (font-lock-keyword-face ((t (:foreground "Cyan")))) (font-lock-string-face ((t (:foreground "LightSalmon")))) (font-lock-type-face ((t (:foreground "PaleGreen")))) (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) (fringe ((t (:background "grey10")))) (header-line ((t (:box (:line-width -1 :style released-button) :foreground "grey20" :background "grey90" :box nil)))) (highlight ((t (:background "darkolivegreen")))) (ibuffer-deletion-face ((t (:foreground "red")))) (ibuffer-marked-face ((t (:foreground "green")))) (isearch ((t (:background "palevioletred2" :foreground "brown4")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:italic t :slant italic)))) (menu ((t (nil)))) (mode-line ((t (:foreground "yellow" :background "darkslateblue" :box (:line-width -1 :style released-button))))) (mouse ((t (:background "white")))) (region ((t (:background "blue")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "darkslateblue")))) (show-block-face1 ((t (:background "gray10")))) (show-block-face2 ((t (:background "gray15")))) (show-block-face3 ((t (:background "gray20")))) (show-block-face4 ((t (:background "gray25")))) (show-block-face5 ((t (:background "gray30")))) (show-block-face6 ((t (:background "gray35")))) (show-block-face7 ((t (:background "gray40")))) (show-block-face8 ((t (:background "gray45")))) (show-block-face9 ((t (:background "gray50")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray"))))))) (defun color-theme-andreas () "Color theme by Andreas Busch, created 2003-02-06." (interactive) (color-theme-install '(color-theme-andreas ((background-mode . light) (background-color . "white") (background-toolbar-color . "#cccccccccccc") (border-color . "#000000000000") (bottom-toolbar-shadow-color . "#7a7a7a7a7a7a") (foreground-color . "black") (top-toolbar-shadow-color . "#f5f5f5f5f5f5")) ((gnus-mouse-face . highlight) (ispell-highlight-face . highlight)) (default ((t (nil)))) (OrangeRed ((t (nil)))) (blue ((t (:foreground "blue")))) (bold ((t (:bold t)))) (bold-italic ((t (:italic t :bold t)))) (border-glyph ((t (nil)))) (calendar-today-face ((t (:underline t)))) (color-mode-face-@ ((t (:foreground "orange")))) (color-mode-face-a ((t (:foreground "blue")))) (color-mode-face-b ((t (:foreground "red")))) (color-mode-face-c ((t (:foreground "green3")))) (color-mode-face-d ((t (:background "red" :foreground "white")))) (color-mode-face-e ((t (:background "orange" :foreground "blue")))) (color-mode-face-f ((t (:background "blue" :foreground "yellow")))) (color-mode-face-g ((t (:background "lightblue" :foreground "brown")))) (color-mode-face-h ((t (:background "brown" :foreground "white")))) (custom-button-face ((t (:bold t)))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:underline t :foreground "blue")))) (custom-group-tag-face-1 ((t (:underline t :foreground "red")))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "dark green")))) (custom-variable-button-face ((t (:underline t :bold t :background "gray90")))) (custom-variable-tag-face ((t (:underline t :background "gray95" :foreground "blue")))) (diary-face ((t (:foreground "red")))) (display-time-mail-balloon-enhance-face ((t (:background "orange")))) (display-time-mail-balloon-gnus-group-face ((t (:foreground "blue")))) (display-time-time-balloon-face ((t (:foreground "red")))) (emacs-wiki-bad-link-face ((t (:bold t :foreground "red")))) (emacs-wiki-link-face ((t (:bold t :foreground "green")))) (font-lock-comment-face ((t (:foreground "orange1")))) (font-lock-doc-string-face ((t (:foreground "green4")))) (font-lock-function-name-face ((t (:foreground "blue3")))) (font-lock-keyword-face ((t (:foreground "red1")))) (font-lock-preprocessor-face ((t (:foreground "blue3")))) (font-lock-reference-face ((t (:foreground "red3")))) (font-lock-string-face ((t (:foreground "green4")))) (font-lock-type-face ((t (:foreground "#6920ac")))) (font-lock-variable-name-face ((t (:foreground "blue3")))) (font-lock-warning-face ((t (:bold t :foreground "Red")))) (gnu-cite-face-3 ((t (nil)))) (gnu-cite-face-4 ((t (nil)))) (gnus-cite-attribution-face ((t (:underline t)))) (gnus-cite-face-1 ((t (:foreground "MidnightBlue")))) (gnus-cite-face-10 ((t (:foreground "medium purple")))) (gnus-cite-face-11 ((t (:foreground "turquoise")))) (gnus-cite-face-2 ((t (:foreground "firebrick")))) (gnus-cite-face-3 ((t (:foreground "dark green")))) (gnus-cite-face-4 ((t (:foreground "OrangeRed")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "dark violet")))) (gnus-cite-face-7 ((t (:foreground "SteelBlue4")))) (gnus-cite-face-8 ((t (:foreground "magenta")))) (gnus-cite-face-9 ((t (:foreground "violet")))) (gnus-emphasis-bold ((t (:bold t)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t)))) (gnus-emphasis-italic ((t (:italic t)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:underline t :bold t)))) (gnus-emphasis-underline-bold-italic ((t (:underline t :italic t :bold t)))) (gnus-emphasis-underline-italic ((t (:underline t :italic t)))) (gnus-group-mail-1-empty-face ((t (:foreground "DeepPink3")))) (gnus-group-mail-1-face ((t (:bold t :foreground "DeepPink3")))) (gnus-group-mail-2-empty-face ((t (:foreground "HotPink3")))) (gnus-group-mail-2-face ((t (:bold t :foreground "HotPink3")))) (gnus-group-mail-3-empty-face ((t (:foreground "magenta4")))) (gnus-group-mail-3-face ((t (:bold t :foreground "magenta4")))) (gnus-group-mail-low-empty-face ((t (:foreground "DeepPink4")))) (gnus-group-mail-low-face ((t (:bold t :foreground "DeepPink4")))) (gnus-group-news-1-empty-face ((t (:foreground "ForestGreen")))) (gnus-group-news-1-face ((t (:bold t :foreground "ForestGreen")))) (gnus-group-news-2-empty-face ((t (:foreground "CadetBlue4")))) (gnus-group-news-2-face ((t (:bold t :foreground "CadetBlue4")))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t)))) (gnus-group-news-low-empty-face ((t (:foreground "DarkGreen")))) (gnus-group-news-low-face ((t (:bold t :foreground "DarkGreen")))) (gnus-header-content-face ((t (:italic t :foreground "indianred4")))) (gnus-header-from-face ((t (:bold t :foreground "red3")))) (gnus-header-name-face ((t (:foreground "maroon")))) (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MidnightBlue")))) (gnus-header-subject-face ((t (:bold t :foreground "red4")))) (gnus-splash-face ((t (:foreground "red")))) (gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "RoyalBlue")))) (gnus-summary-high-read-face ((t (:bold t :foreground "DarkGreen")))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "DarkRed")))) (gnus-summary-high-unread-face ((t (:bold t)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "RoyalBlue")))) (gnus-summary-low-read-face ((t (:italic t :foreground "DarkGreen")))) (gnus-summary-low-ticked-face ((t (:italic t :foreground "firebrick")))) (gnus-summary-low-unread-face ((t (:italic t)))) (gnus-summary-normal-ancient-face ((t (:foreground "RoyalBlue")))) (gnus-summary-normal-read-face ((t (:foreground "DarkGreen")))) (gnus-summary-normal-ticked-face ((t (:foreground "Red")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (gnus-x-face ((t (nil)))) (green ((t (:foreground "green")))) (gui-button-face ((t (:background "grey75")))) (gui-element ((t (:background "Gray80")))) (highlight ((t (nil)))) (holiday-face ((t (:background "pink")))) (hyper-apropos-documentation ((t (:foreground "darkred")))) (hyper-apropos-heading ((t (:bold t)))) (hyper-apropos-hyperlink ((t (:foreground "blue4")))) (hyper-apropos-major-heading ((t (:bold t)))) (hyper-apropos-section-heading ((t (:italic t :bold t)))) (hyper-apropos-warning ((t (:bold t :foreground "red")))) (info-node ((t (:italic t :bold t)))) (info-xref ((t (:bold t)))) (isearch ((t (:background "yellow" :foreground "red")))) (italic ((t (:italic t)))) (kai-gnus-cite-face-1 ((t (:foreground "LightCyan4")))) (kai-gnus-cite-face-2 ((t (:foreground "LightSkyBlue2")))) (kai-gnus-cite-face-3 ((t (:foreground "DodgerBlue3")))) (kai-gnus-group-mail-face ((t (:foreground "darkslategrey")))) (kai-gnus-group-nonempty-mail-face ((t (:foreground "DarkRed")))) (kai-gnus-group-starred-face ((t (:foreground "grey50")))) (left-margin ((t (nil)))) (list-mode-item-selected ((t (:background "gray68")))) (message-cited-text ((t (:italic t)))) (message-cited-text-face ((t (:foreground "red")))) (message-header-cc-face ((t (:foreground "MidnightBlue")))) (message-header-contents ((t (:italic t)))) (message-header-name-face ((t (:foreground "cornflower blue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "blue4")))) (message-header-other-face ((t (:foreground "steel blue")))) (message-header-subject-face ((t (:bold t :foreground "navy blue")))) (message-header-to-face ((t (:bold t :foreground "MidnightBlue")))) (message-header-xheader-face ((t (:foreground "blue")))) (message-headers ((t (:bold t)))) (message-highlighted-header-contents ((t (:italic t :bold t)))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "brown")))) (modeline ((t (:background "Gray75" :foreground "Black")))) (modeline-buffer-id ((t (:background "Gray75" :foreground "blue4")))) (modeline-mousable ((t (:background "Gray75" :foreground "firebrick")))) (modeline-mousable-minor-mode ((t (:background "Gray75" :foreground "green4")))) (paren-blink-off ((t (:foreground "gray80")))) (paren-match ((t (:background "red" :foreground "white")))) (paren-mismatch ((t (:background "DeepPink")))) (pointer ((t (:foreground "blue")))) (primary-selection ((t (:background "gray65")))) (red ((t (:foreground "red")))) (region ((t (:background "gray75")))) (right-margin ((t (nil)))) (secondary-selection ((t (:background "paleturquoise")))) (text-cursor ((t (:background "red" :foreground "LightYellow1")))) (toolbar ((t (:background "Gray80")))) (underline ((t (:underline t)))) (vertical-divider ((t (:background "Gray80")))) (widget-button-face ((t (:bold t)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (x-face ((t (:background "white")))) (yellow ((t (:foreground "yellow")))) (zmacs-region ((t (:background "gray65" :foreground "yellow"))))))) (defun color-theme-charcoal-black () "Color theme by Lars Chr. Hausmann, created 2003-03-24." (interactive) (color-theme-install '(color-theme-charcoal-black ((background-color . "Grey15") (background-mode . dark) (border-color . "Grey") (cursor-color . "Grey") (foreground-color . "Grey") (mouse-color . "Grey")) ((display-time-mail-face . mode-line) (gnus-article-button-face . bold) (gnus-article-mouse-face . highlight) (gnus-mouse-face . highlight) (gnus-server-agent-face . gnus-server-agent-face) (gnus-server-closed-face . gnus-server-closed-face) (gnus-server-denied-face . gnus-server-denied-face) (gnus-server-offline-face . gnus-server-offline-face) (gnus-server-opened-face . gnus-server-opened-face) (gnus-signature-face . gnus-signature-face) (gnus-summary-selected-face . gnus-summary-selected-face) (help-highlight-face . underline) (list-matching-lines-face . bold) (mime-button-face . bold) (mime-button-mouse-face . highlight) (sgml-set-face . t) (tags-tag-face . default) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "Grey15" :foreground "Grey" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 87 :width semi-condensed :family "misc-fixed")))) (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) (bg:erc-color-face0 ((t (nil)))) (bg:erc-color-face1 ((t (nil)))) (bg:erc-color-face10 ((t (nil)))) (bg:erc-color-face11 ((t (nil)))) (bg:erc-color-face12 ((t (nil)))) (bg:erc-color-face13 ((t (nil)))) (bg:erc-color-face14 ((t (nil)))) (bg:erc-color-face15 ((t (nil)))) (bg:erc-color-face2 ((t (nil)))) (bg:erc-color-face3 ((t (nil)))) (bg:erc-color-face4 ((t (nil)))) (bg:erc-color-face5 ((t (nil)))) (bg:erc-color-face6 ((t (nil)))) (bg:erc-color-face7 ((t (nil)))) (bg:erc-color-face8 ((t (nil)))) (bg:erc-color-face9 ((t (nil)))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:bold t :foreground "beige" :weight bold)))) (border ((t (:background "Grey")))) (calendar-today-face ((t (:underline t)))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cperl-array-face ((t (:bold t :foreground "light salmon" :weight bold)))) (cperl-hash-face ((t (:italic t :bold t :foreground "beige" :slant italic :weight bold)))) (cperl-nonoverridable-face ((t (:foreground "aquamarine")))) (cursor ((t (:background "Grey")))) (custom-button-face ((t (:foreground "gainsboro")))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "dim gray")))) (custom-comment-tag-face ((t (:foreground "gray80")))) (custom-documentation-face ((t (:foreground "light blue")))) (custom-face-tag-face ((t (:underline t)))) (custom-group-tag-face ((t (:bold t :foreground "pale turquoise" :weight bold)))) (custom-group-tag-face-1 ((t (:foreground "pale turquoise" :underline t)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "light salmon")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :foreground "turquoise" :weight bold)))) (diary-face ((t (:foreground "red")))) (dired-face-directory ((t (:bold t :foreground "sky blue" :weight bold)))) (dired-face-executable ((t (:foreground "green yellow")))) (dired-face-flagged ((t (:foreground "tomato")))) (dired-face-marked ((t (:foreground "light salmon")))) (dired-face-permissions ((t (:foreground "aquamarine")))) (erc-action-face ((t (nil)))) (erc-bold-face ((t (:bold t :weight bold)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "pale green")))) (erc-error-face ((t (:bold t :foreground "IndianRed" :weight bold)))) (erc-highlight-face ((t (:bold t :foreground "pale green" :weight bold)))) (erc-input-face ((t (:foreground "light blue")))) (erc-inverse-face ((t (:background "steel blue")))) (erc-notice-face ((t (:foreground "light salmon")))) (erc-pal-face ((t (:foreground "pale green")))) (erc-prompt-face ((t (:bold t :foreground "light blue" :weight bold)))) (eshell-ls-archive-face ((t (:bold t :foreground "medium purple" :weight bold)))) (eshell-ls-backup-face ((t (:foreground "dim gray")))) (eshell-ls-clutter-face ((t (:foreground "dim gray")))) (eshell-ls-directory-face ((t (:bold t :foreground "medium slate blue" :weight bold)))) (eshell-ls-executable-face ((t (:bold t :foreground "aquamarine" :weight bold)))) (eshell-ls-missing-face ((t (:foreground "black")))) (eshell-ls-picture-face ((t (:foreground "violet")))) (eshell-ls-product-face ((t (:foreground "light steel blue")))) (eshell-ls-readonly-face ((t (:foreground "aquamarine")))) (eshell-ls-special-face ((t (:foreground "gold")))) (eshell-ls-symlink-face ((t (:foreground "white")))) (eshell-ls-unreadable-face ((t (:foreground "dim gray")))) (eshell-prompt-face ((t (:bold t :foreground "light sky blue" :weight bold)))) (excerpt ((t (:italic t :slant italic)))) (fg:erc-color-face0 ((t (:foreground "white")))) (fg:erc-color-face1 ((t (:foreground "beige")))) (fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) (fg:erc-color-face11 ((t (:foreground "light goldenrod yellow")))) (fg:erc-color-face12 ((t (:foreground "light yellow")))) (fg:erc-color-face13 ((t (:foreground "yellow")))) (fg:erc-color-face14 ((t (:foreground "light goldenrod")))) (fg:erc-color-face15 ((t (:foreground "lime green")))) (fg:erc-color-face2 ((t (:foreground "lemon chiffon")))) (fg:erc-color-face3 ((t (:foreground "light cyan")))) (fg:erc-color-face4 ((t (:foreground "powder blue")))) (fg:erc-color-face5 ((t (:foreground "sky blue")))) (fg:erc-color-face6 ((t (:foreground "dark sea green")))) (fg:erc-color-face7 ((t (:foreground "pale green")))) (fg:erc-color-face8 ((t (:foreground "medium spring green")))) (fg:erc-color-face9 ((t (:foreground "khaki")))) (fixed ((t (:bold t :weight bold)))) (fixed-pitch ((t (:family "courier")))) (flyspell-duplicate-face ((t (:bold t :foreground "Gold3" :underline t :weight bold)))) (flyspell-incorrect-face ((t (:bold t :foreground "OrangeRed" :underline t :weight bold)))) (font-lock-builtin-face ((t (:foreground "aquamarine")))) (font-lock-comment-face ((t (:foreground "light blue")))) (font-lock-constant-face ((t (:foreground "pale green")))) (font-lock-doc-face ((t (:foreground "light sky blue")))) (font-lock-doc-string-face ((t (:foreground "sky blue")))) (font-lock-function-name-face ((t (:bold t :foreground "aquamarine" :weight bold)))) (font-lock-keyword-face ((t (:bold t :foreground "pale turquoise" :weight bold)))) (font-lock-reference-face ((t (:foreground "pale green")))) (font-lock-string-face ((t (:foreground "light sky blue")))) (font-lock-type-face ((t (:bold t :foreground "sky blue" :weight bold)))) (font-lock-variable-name-face ((t (:bold t :foreground "turquoise" :weight bold)))) (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) (fringe ((t (:background "Grey15")))) (gnus-cite-face-1 ((t (:foreground "LightSalmon")))) (gnus-cite-face-2 ((t (:foreground "Khaki")))) (gnus-cite-face-3 ((t (:foreground "Coral")))) (gnus-cite-face-4 ((t (:foreground "yellow green")))) (gnus-cite-face-5 ((t (:foreground "dark khaki")))) (gnus-cite-face-6 ((t (:foreground "bisque")))) (gnus-cite-face-7 ((t (:foreground "peru")))) (gnus-cite-face-8 ((t (:foreground "light coral")))) (gnus-cite-face-9 ((t (:foreground "plum")))) (gnus-emphasis-bold ((t (:bold t :weight bold)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) (gnus-emphasis-italic ((t (:italic t :slant italic)))) (gnus-emphasis-strikethru ((t (nil)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) (gnus-group-mail-1-empty-face ((t (:foreground "White")))) (gnus-group-mail-1-face ((t (:bold t :foreground "White" :weight bold)))) (gnus-group-mail-2-empty-face ((t (:foreground "light cyan")))) (gnus-group-mail-2-face ((t (:bold t :foreground "light cyan" :weight bold)))) (gnus-group-mail-3-empty-face ((t (:foreground "LightBlue")))) (gnus-group-mail-3-face ((t (:bold t :foreground "LightBlue" :weight bold)))) (gnus-group-mail-low-empty-face ((t (:foreground "Aquamarine")))) (gnus-group-mail-low-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) (gnus-group-news-1-empty-face ((t (:foreground "White")))) (gnus-group-news-1-face ((t (:bold t :foreground "White" :weight bold)))) (gnus-group-news-2-empty-face ((t (:foreground "light cyan")))) (gnus-group-news-2-face ((t (:bold t :foreground "light cyan" :weight bold)))) (gnus-group-news-3-empty-face ((t (:foreground "LightBlue")))) (gnus-group-news-3-face ((t (:bold t :foreground "LightBlue" :weight bold)))) (gnus-group-news-4-empty-face ((t (:foreground "Aquamarine")))) (gnus-group-news-4-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) (gnus-group-news-5-empty-face ((t (:foreground "MediumAquamarine")))) (gnus-group-news-5-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) (gnus-group-news-6-empty-face ((t (:foreground "MediumAquamarine")))) (gnus-group-news-6-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) (gnus-group-news-low-empty-face ((t (:foreground "MediumAquamarine")))) (gnus-group-news-low-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) (gnus-header-content-face ((t (:foreground "LightSkyBlue3")))) (gnus-header-from-face ((t (:bold t :foreground "light cyan" :weight bold)))) (gnus-header-name-face ((t (:bold t :foreground "LightBlue" :weight bold)))) (gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "MediumAquamarine" :slant italic :weight bold)))) (gnus-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) (gnus-server-agent-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) (gnus-server-closed-face ((t (:italic t :foreground "Light Steel Blue" :slant italic)))) (gnus-server-denied-face ((t (:bold t :foreground "Pink" :weight bold)))) (gnus-server-offline-face ((t (:bold t :foreground "Yellow" :weight bold)))) (gnus-server-opened-face ((t (:bold t :foreground "Green1" :weight bold)))) (gnus-signature-face ((t (:foreground "Grey")))) (gnus-splash-face ((t (:foreground "ForestGreen")))) (gnus-summary-cancelled-face ((t (:background "Black" :foreground "Yellow")))) (gnus-summary-high-ancient-face ((t (:bold t :foreground "MediumAquamarine" :weight bold)))) (gnus-summary-high-read-face ((t (:bold t :foreground "Aquamarine" :weight bold)))) (gnus-summary-high-ticked-face ((t (:bold t :foreground "LightSalmon" :weight bold)))) (gnus-summary-high-unread-face ((t (:italic t :bold t :foreground "beige" :slant italic :weight bold)))) (gnus-summary-low-ancient-face ((t (:italic t :foreground "DimGray" :slant italic)))) (gnus-summary-low-read-face ((t (:foreground "slate gray")))) (gnus-summary-low-ticked-face ((t (:foreground "Pink")))) (gnus-summary-low-unread-face ((t (:foreground "LightGray")))) (gnus-summary-normal-ancient-face ((t (:foreground "MediumAquamarine")))) (gnus-summary-normal-read-face ((t (:foreground "Aquamarine")))) (gnus-summary-normal-ticked-face ((t (:foreground "LightSalmon")))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:underline t)))) (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) (highlight ((t (:background "dark slate blue" :foreground "light blue")))) (highline-face ((t (:background "DeepSkyBlue4")))) (holiday-face ((t (:background "pink")))) (info-header-node ((t (:bold t :weight bold)))) (info-header-xref ((t (:bold t :weight bold :foreground "sky blue")))) (info-menu-5 ((t (:underline t)))) (info-menu-header ((t (:bold t :family "helv" :weight bold)))) (info-node ((t (:bold t :weight bold)))) (info-xref ((t (:bold t :foreground "sky blue" :weight bold)))) (isearch ((t (:background "slate blue")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:foreground "sky blue")))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-bug-breakpoint-marker ((t (:background "yellow" :foreground "red")))) (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) (jde-java-font-lock-code-face ((t (nil)))) (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) (jde-java-font-lock-pre-face ((t (nil)))) (jde-java-font-lock-underline-face ((t (:underline t)))) (makefile-space-face ((t (:background "hotpink")))) (menu ((t (:background "MidnightBlue" :foreground "Grey")))) (message-cited-text-face ((t (:foreground "LightSalmon")))) (message-header-cc-face ((t (:foreground "light cyan")))) (message-header-name-face ((t (:foreground "LightBlue")))) (message-header-newsgroups-face ((t (:italic t :bold t :foreground "MediumAquamarine" :slant italic :weight bold)))) (message-header-other-face ((t (:foreground "MediumAquamarine")))) (message-header-subject-face ((t (:bold t :foreground "light cyan" :weight bold)))) (message-header-to-face ((t (:bold t :foreground "light cyan" :weight bold)))) (message-header-xheader-face ((t (:foreground "MediumAquamarine")))) (message-mml-face ((t (:foreground "ForestGreen")))) (message-separator-face ((t (:foreground "chocolate")))) (mode-line ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (mouse ((t (:background "Grey")))) (region ((t (:background "DarkSlateBlue")))) (scroll-bar ((t (:background "grey75")))) (secondary-selection ((t (:background "steel blue")))) (semantic-dirty-token-face ((t (:background "gray10")))) (semantic-unmatched-syntax-face ((t (:underline "red")))) (show-paren-match-face ((t (:background "light slate blue" :foreground "white")))) (show-paren-mismatch-face ((t (:background "red" :foreground "white")))) (speedbar-button-face ((t (:foreground "seashell2")))) (speedbar-directory-face ((t (:foreground "seashell3")))) (speedbar-file-face ((t (:foreground "seashell4")))) (speedbar-highlight-face ((t (:background "dark slate blue" :foreground "wheat")))) (speedbar-selected-face ((t (:foreground "seashell1" :underline t)))) (speedbar-separator-face ((t (:background "blue" :foreground "white" :overline "gray")))) (speedbar-tag-face ((t (:foreground "antique white")))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "light blue")))) (widget-field-face ((t (:background "RoyalBlue4" :foreground "wheat")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "slate blue" :foreground "wheat")))) (woman-bold-face ((t (:bold t :foreground "sky blue" :weight bold)))) (woman-italic-face ((t (:foreground "deep sky blue")))) (woman-unknown-face ((t (:foreground "LightSalmon")))) (zmacs-region ((t (:background "DarkSlateBlue"))))))) (defun color-theme-vim-colors () "Color theme by Michael Soulier, created 2003-03-26." (interactive) (color-theme-install '(color-theme-vim-colors ((background-color . "#ffffff") (background-mode . light) (border-color . "black") (cursor-color . "#000000") (foreground-color . "#000000") (mouse-color . "#000000")) ((Man-overstrike-face . bold) (Man-underline-face . underline) (apropos-keybinding-face . underline) (apropos-label-face . italic) (apropos-match-face . secondary-selection) (apropos-property-face . bold-italic) (apropos-symbol-face . bold) (cperl-here-face . font-lock-string-face) (cperl-invalid-face quote underline) (cperl-pod-face . font-lock-comment-face) (cperl-pod-head-face . font-lock-variable-name-face) (help-highlight-face . underline) (ispell-highlight-face . highlight) (list-matching-lines-face . bold) (rpm-spec-dir-face . rpm-spec-dir-face) (rpm-spec-doc-face . rpm-spec-doc-face) (rpm-spec-ghost-face . rpm-spec-ghost-face) (rpm-spec-macro-face . rpm-spec-macro-face) (rpm-spec-package-face . rpm-spec-package-face) (rpm-spec-tag-face . rpm-spec-tag-face) (tags-tag-face . default) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:background "#ffffff" :foreground "#000000")))) (Info-title-1-face ((t (nil)))) (Info-title-2-face ((t (nil)))) (Info-title-3-face ((t (nil)))) (Info-title-4-face ((t (:bold (bold extra-bold ultra-bold))))) (bold ((t (:bold (bold extra-bold ultra-bold))))) (bold-italic ((t (:italic (italic oblique) :bold (bold extra-bold ultra-bold))))) (border ((t (:background "black")))) (comint-highlight-input ((t (:bold (bold extra-bold ultra-bold))))) (comint-highlight-prompt ((t (:foreground "dark blue")))) (cperl-array-face ((t (:foreground "brown")))) (cperl-hash-face ((t (:foreground "red")))) (cperl-nonoverridable-face ((t (:foreground "#008b8b")))) (cursor ((t (:background "#000000")))) (fixed-pitch ((t (nil)))) (font-lock-builtin-face ((t (:foreground "purple")))) (font-lock-comment-face ((t (:foreground "blue")))) (font-lock-constant-face ((t (:foreground "green4")))) (font-lock-doc-face ((t (:background "#f2f2f2")))) (font-lock-function-name-face ((t (:foreground "#008b8b")))) (font-lock-keyword-face ((t (:bold (bold extra-bold ultra-bold) :foreground "#a52a2a")))) (font-lock-string-face ((t (:background "#f2f2f2" :foreground "#ff00ff")))) (font-lock-type-face ((t (:foreground "ForestGreen")))) (font-lock-variable-name-face ((t (:foreground "#008b8b")))) (font-lock-warning-face ((t (:bold (bold extra-bold ultra-bold) :foreground "Red")))) (fringe ((t (:background "#e5e5e5")))) (header-line ((t (:background "grey90" :foreground "grey20")))) (highlight ((t (:background "darkseagreen2")))) (info-header-node ((t (nil)))) (info-header-xref ((t (nil)))) (info-menu-5 ((t (:foreground "red1")))) (info-menu-header ((t (:bold (bold extra-bold ultra-bold))))) (info-node ((t (:italic (italic oblique) :bold (bold extra-bold ultra-bold) :foreground "brown")))) (info-xref ((t (:bold (bold extra-bold ultra-bold) :foreground "magenta4")))) (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) (italic ((t (:italic (italic oblique))))) (menu ((t (nil)))) (mode-line ((t (:background "grey75" :foreground "black")))) (mouse ((t (:background "#000000")))) (region ((t (:background "lightgoldenrod2")))) (rpm-spec-dir-face ((t (:foreground "green")))) (rpm-spec-doc-face ((t (:foreground "magenta")))) (rpm-spec-ghost-face ((t (:foreground "red")))) (rpm-spec-macro-face ((t (:foreground "purple")))) (rpm-spec-package-face ((t (:foreground "red")))) (rpm-spec-tag-face ((t (:foreground "blue")))) (scroll-bar ((t (:background "grey75" :foreground "#000000")))) (secondary-selection ((t (:background "yellow")))) (sh-heredoc-face ((t (:foreground "tan")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (tool-bar ((t (:background "grey75" :foreground "black")))) (tooltip ((t (:background "lightyellow" :foreground "black")))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (nil)))) (widget-button-face ((t (:bold (bold extra-bold ultra-bold))))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85"))))))) (defun color-theme-calm-forest () "Color theme by Artur Hefczyc, created 2003-04-18." (interactive) (color-theme-install '(color-theme-calm-forest ((background-color . "gray12") (background-mode . dark) (border-color . "black") (cursor-color . "orange") (foreground-color . "green") (mouse-color . "yellow")) ((help-highlight-face . underline) (list-matching-lines-face . bold) (senator-eldoc-use-color . t) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "gray12" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 98 :width normal :family "outline-courier new")))) (Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) (Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) (Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) (Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (comint-highlight-input ((t (:bold t :weight bold)))) (comint-highlight-prompt ((t (:foreground "cyan")))) (cparen-around-andor-face ((t (:bold t :foreground "maroon" :weight bold)))) (cparen-around-begin-face ((t (:foreground "maroon")))) (cparen-around-conditional-face ((t (:bold t :foreground "RoyalBlue" :weight bold)))) (cparen-around-define-face ((t (:bold t :foreground "Blue" :weight bold)))) (cparen-around-lambda-face ((t (:foreground "LightSeaGreen")))) (cparen-around-letdo-face ((t (:bold t :foreground "LightSeaGreen" :weight bold)))) (cparen-around-quote-face ((t (:foreground "SaddleBrown")))) (cparen-around-set!-face ((t (:foreground "OrangeRed")))) (cparen-around-syntax-rules-face ((t (:foreground "Magenta")))) (cparen-around-vector-face ((t (:foreground "chocolate")))) (cparen-binding-face ((t (:foreground "ForestGreen")))) (cparen-binding-list-face ((t (:bold t :foreground "ForestGreen" :weight bold)))) (cparen-conditional-clause-face ((t (:foreground "RoyalBlue")))) (cparen-normal-paren-face ((t (:foreground "grey50")))) (cursor ((t (:background "orange")))) (custom-button-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) (custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button))))) (custom-changed-face ((t (:background "blue" :foreground "white")))) (custom-comment-face ((t (:background "dim gray")))) (custom-comment-tag-face ((t (:foreground "gray80")))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.2)))) (custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.2)))) (custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.2)))) (custom-invalid-face ((t (:background "red" :foreground "yellow")))) (custom-modified-face ((t (:background "blue" :foreground "white")))) (custom-rogue-face ((t (:background "black" :foreground "pink")))) (custom-saved-face ((t (:underline t)))) (custom-set-face ((t (:background "white" :foreground "blue")))) (custom-state-face ((t (:foreground "lime green")))) (custom-variable-button-face ((t (:bold t :underline t :weight bold)))) (custom-variable-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.2)))) (eieio-custom-slot-tag-face ((t (:foreground "light blue")))) (extra-whitespace-face ((t (:background "pale green")))) (fixed-pitch ((t (:family "courier")))) (font-latex-bold-face ((t (:bold t :foreground "OliveDrab" :weight bold)))) (font-latex-italic-face ((t (:italic t :foreground "OliveDrab" :slant italic)))) (font-latex-math-face ((t (:foreground "burlywood")))) (font-latex-sedate-face ((t (:foreground "LightGray")))) (font-latex-string-face ((t (:foreground "RosyBrown")))) (font-latex-warning-face ((t (:bold t :foreground "Red" :weight bold)))) (font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) (font-lock-comment-face ((t (:foreground "chocolate1")))) (font-lock-constant-face ((t (:foreground "Aquamarine")))) (font-lock-doc-face ((t (:foreground "LightSalmon")))) (font-lock-function-name-face ((t (:foreground "LightSkyBlue")))) (font-lock-keyword-face ((t (:foreground "Cyan")))) (font-lock-string-face ((t (:foreground "LightSalmon")))) (font-lock-type-face ((t (:foreground "PaleGreen")))) (font-lock-variable-name-face ((t (:foreground "LightGoldenrod")))) (font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) (fringe ((t (:background "grey10")))) (header-line ((t (:box (:line-width -1 :style released-button) :background "grey20" :foreground "grey90" :box nil)))) (highlight ((t (:background "darkolivegreen")))) (info-header-node ((t (:italic t :bold t :weight bold :slant italic :foreground "white")))) (info-header-xref ((t (:bold t :weight bold :foreground "cyan")))) (info-menu-5 ((t (:foreground "red1")))) (info-menu-header ((t (:bold t :family "helv" :weight bold)))) (info-node ((t (:italic t :bold t :foreground "white" :slant italic :weight bold)))) (info-xref ((t (:bold t :foreground "cyan" :weight bold)))) (isearch ((t (:background "palevioletred2" :foreground "brown4")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) (italic ((t (:italic t :slant italic)))) (jde-bug-breakpoint-cursor ((t (:background "brown" :foreground "cyan")))) (jde-db-active-breakpoint-face ((t (:background "red" :foreground "black")))) (jde-db-requested-breakpoint-face ((t (:background "yellow" :foreground "black")))) (jde-db-spec-breakpoint-face ((t (:background "green" :foreground "black")))) (jde-java-font-lock-api-face ((t (:foreground "light goldenrod")))) (jde-java-font-lock-bold-face ((t (:bold t :weight bold)))) (jde-java-font-lock-code-face ((t (nil)))) (jde-java-font-lock-constant-face ((t (:foreground "Aquamarine")))) (jde-java-font-lock-doc-tag-face ((t (:foreground "light coral")))) (jde-java-font-lock-italic-face ((t (:italic t :slant italic)))) (jde-java-font-lock-link-face ((t (:foreground "blue" :underline t :slant normal)))) (jde-java-font-lock-modifier-face ((t (:foreground "LightSteelBlue")))) (jde-java-font-lock-number-face ((t (:foreground "LightSalmon")))) (jde-java-font-lock-operator-face ((t (:foreground "medium blue")))) (jde-java-font-lock-package-face ((t (:foreground "steelblue1")))) (jde-java-font-lock-pre-face ((t (nil)))) (jde-java-font-lock-underline-face ((t (:underline t)))) (menu ((t (nil)))) (mode-line ((t (:background "grey75" :foreground "black" :box (:line-width -1 :style released-button))))) (mouse ((t (:background "yellow")))) (region ((t (:background "blue3")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "SkyBlue4")))) (semantic-dirty-token-face ((t (:background "gray10")))) (semantic-unmatched-syntax-face ((t (:underline "red")))) (senator-intangible-face ((t (:foreground "gray75")))) (senator-momentary-highlight-face ((t (:background "gray30")))) (senator-read-only-face ((t (:background "#664444")))) (show-paren-match-face ((t (:background "turquoise")))) (show-paren-mismatch-face ((t (:background "purple" :foreground "white")))) (speedbar-button-face ((t (:foreground "green3")))) (speedbar-directory-face ((t (:foreground "light blue")))) (speedbar-file-face ((t (:foreground "cyan")))) (speedbar-highlight-face ((t (:background "sea green")))) (speedbar-selected-face ((t (:foreground "red" :underline t)))) (speedbar-separator-face ((t (:background "blue" :foreground "white" :overline "gray")))) (speedbar-tag-face ((t (:foreground "yellow")))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "lime green")))) (widget-field-face ((t (:background "dim gray")))) (widget-inactive-face ((t (:foreground "light gray")))) (widget-single-line-field-face ((t (:background "dim gray"))))))) (defun color-theme-lawrence () "Color theme by lawrence mitchell . Mainly shades of green. Contains faces for erc, gnus, most of jde." (interactive) (color-theme-install '(color-theme-lawrence ((background-color . "black") (background-mode . dark) (border-color . "black") (cursor-color . "green") (foreground-color . "#00CC00") (mouse-color . "black")) ((erc-button-face . bold) (erc-button-mouse-face . highlight) (gnus-article-button-face . bold) (gnus-article-mouse-face . highlight) (gnus-cite-attribution-face . gnus-cite-attribution-face) (gnus-mouse-face . highlight) (gnus-server-agent-face . gnus-server-agent-face) (gnus-server-closed-face . gnus-server-closed-face) (gnus-server-denied-face . gnus-server-denied-face) (gnus-server-offline-face . gnus-server-offline-face) (gnus-server-opened-face . gnus-server-opened-face) (gnus-signature-face . gnus-signature-face) (gnus-summary-selected-face . gnus-summary-selected-face) (gnus-treat-display-face . head) (gnus-treat-display-xface . head) (list-matching-lines-buffer-name-face . underline) (list-matching-lines-face . bold) (paren-match-face . paren-face-match) (paren-mismatch-face . paren-face-mismatch) (paren-no-match-face . paren-face-no-match) (sgml-set-face . t) (tags-tag-face . default) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (nil)))) (Buffer-menu-buffer-face ((t (:bold t :weight bold)))) (bg:erc-color-face0 ((t (:background "White")))) (bg:erc-color-face1 ((t (:background "black")))) (bg:erc-color-face10 ((t (:background "lightblue1")))) (bg:erc-color-face11 ((t (:background "cyan")))) (bg:erc-color-face12 ((t (:background "blue")))) (bg:erc-color-face13 ((t (:background "deeppink")))) (bg:erc-color-face14 ((t (:background "gray50")))) (bg:erc-color-face15 ((t (:background "gray90")))) (bg:erc-color-face2 ((t (:background "blue4")))) (bg:erc-color-face3 ((t (:background "green4")))) (bg:erc-color-face4 ((t (:background "red")))) (bg:erc-color-face5 ((t (:background "brown")))) (bg:erc-color-face6 ((t (:background "purple")))) (bg:erc-color-face7 ((t (:background "orange")))) (bg:erc-color-face8 ((t (:background "yellow")))) (bg:erc-color-face9 ((t (:background "green")))) (bold ((t (:bold t :foreground "#00CC00" :background "black")))) (bold-italic ((t (:italic t :bold t :slant oblique :weight semi-bold)))) (border ((t (:background "black")))) (button ((t (:underline t)))) (comint-highlight-input ((t (nil)))) (comint-highlight-prompt ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (cursor ((t (:background "green")))) (custom-button-face ((t (:bold t :foreground "#00CC00" :background "black")))) (custom-button-pressed-face ((t (nil)))) (custom-changed-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) (custom-comment-face ((t (nil)))) (custom-comment-tag-face ((t (nil)))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (nil)))) (custom-group-tag-face ((t (nil)))) (custom-group-tag-face-1 ((t (nil)))) (custom-invalid-face ((t (:foreground "#00CC00" :background "black" :strike-through t)))) (custom-modified-face ((t (nil)))) (custom-rogue-face ((t (nil)))) (custom-saved-face ((t (nil)))) (custom-set-face ((t (nil)))) (custom-state-face ((t (nil)))) (custom-variable-button-face ((t (nil)))) (custom-variable-tag-face ((t (nil)))) (erc-action-face ((t (:bold t :weight semi-bold)))) (erc-bold-face ((t (:bold t :weight bold)))) (erc-current-nick-face ((t (:bold t :foreground "LightSeaGreen" :weight semi-bold)))) (erc-dangerous-host-face ((t (:foreground "red")))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (:foreground "IndianRed")))) (erc-error-face ((t (:bold t :weight semi-bold :background "darkblue" :foreground "#00CC00")))) (erc-fool-face ((t (:foreground "dim gray")))) (erc-input-face ((t (:foreground "springgreen")))) (erc-inverse-face ((t (:bold t :background "Darkgreen" :foreground "Black" :weight semi-bold)))) (erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold)))) (erc-nick-default-face ((t (:bold t :weight semi-bold)))) (erc-nick-msg-face ((t (:bold t :foreground "springgreen" :weight semi-bold)))) (erc-notice-face ((t (:foreground "seagreen" :weight normal)))) (erc-pal-face ((t (:bold t :foreground "Magenta" :weight bold)))) (erc-prompt-face ((t (:bold t :background "lightBlue2" :foreground "Black" :weight semi-bold)))) (erc-timestamp-face ((t (:foreground "seagreen" :weight normal)))) (erc-underline-face ((t (:underline t)))) (fg:erc-color-face0 ((t (:foreground "White")))) (fg:erc-color-face1 ((t (:foreground "black")))) (fg:erc-color-face10 ((t (:foreground "lightblue1")))) (fg:erc-color-face11 ((t (:foreground "cyan")))) (fg:erc-color-face12 ((t (:foreground "blue")))) (fg:erc-color-face13 ((t (:foreground "deeppink")))) (fg:erc-color-face14 ((t (:foreground "gray50")))) (fg:erc-color-face15 ((t (:foreground "gray90")))) (fg:erc-color-face2 ((t (:foreground "blue4")))) (fg:erc-color-face3 ((t (:foreground "green4")))) (fg:erc-color-face4 ((t (:foreground "red")))) (fg:erc-color-face5 ((t (:foreground "brown")))) (fg:erc-color-face6 ((t (:foreground "purple")))) (fg:erc-color-face7 ((t (:foreground "orange")))) (fg:erc-color-face8 ((t (:foreground "yellow")))) (fg:erc-color-face9 ((t (:foreground "green")))) (fixed-pitch ((t (nil)))) (font-latex-string-face ((t (:bold t :weight semi-bold :foreground "seagreen" :background "black")))) (font-latex-warning-face ((t (:bold t :weight semi-bold :background "darkblue" :foreground "#00CC00")))) (font-lock-builtin-face ((t (:foreground "seagreen1")))) (font-lock-comment-face ((t (:background "black" :foreground "medium spring green")))) (font-lock-constant-face ((t (nil)))) (font-lock-doc-face ((t (:bold t :background "black" :foreground "seagreen" :weight semi-bold)))) (font-lock-function-name-face ((t (:bold t :foreground "#00CC00" :background "black")))) (font-lock-keyword-face ((t (:bold t :background "black" :foreground "green" :underline t :weight semi-bold)))) (font-lock-preprocessor-face ((t (:foreground "#00ccdd")))) (font-lock-string-face ((t (:bold t :background "black" :foreground "seagreen" :weight semi-bold)))) (font-lock-type-face ((t (nil)))) (font-lock-variable-name-face ((t (nil)))) (font-lock-warning-face ((t (:bold t :foreground "#00CC00" :background "darkblue" :weight semi-bold)))) (fringe ((t (:foreground "#00CC00" :background "#151515")))) (gnus-cite-attribution-face ((t (:italic t :foreground "#00CC00" :background "black" :slant italic)))) (gnus-cite-face-1 ((t (:background "black" :foreground "springgreen")))) (gnus-cite-face-10 ((t (nil)))) (gnus-cite-face-11 ((t (nil)))) (gnus-cite-face-2 ((t (:background "black" :foreground "lightseagreen")))) (gnus-cite-face-3 ((t (:background "black" :foreground "darkseagreen")))) (gnus-cite-face-4 ((t (:background "black" :foreground "forestgreen")))) (gnus-cite-face-5 ((t (:background "black" :foreground "springgreen")))) (gnus-cite-face-6 ((t (:background "black" :foreground "springgreen")))) (gnus-cite-face-7 ((t (:background "black" :foreground "springgreen")))) (gnus-cite-face-8 ((t (:background "black" :foreground "springgreen")))) (gnus-cite-face-9 ((t (:background "black" :foreground "springgreen")))) (gnus-emphasis-bold ((t (:bold t :weight semi-bold)))) (gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight semi-bold)))) (gnus-emphasis-highlight-words ((t (:bold t :foreground "#00CC00" :background "black" :underline t :weight bold)))) (gnus-emphasis-italic ((t (:italic t :slant italic)))) (gnus-emphasis-strikethru ((t (nil)))) (gnus-emphasis-underline ((t (:underline t)))) (gnus-emphasis-underline-bold ((t (:bold t :underline t :weight semi-bold)))) (gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight semi-bold)))) (gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) (gnus-group-mail-1-empty-face ((t (nil)))) (gnus-group-mail-1-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-group-mail-2-empty-face ((t (nil)))) (gnus-group-mail-2-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-group-mail-3-empty-face ((t (nil)))) (gnus-group-mail-3-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-group-mail-low-empty-face ((t (nil)))) (gnus-group-mail-low-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-group-news-1-empty-face ((t (nil)))) (gnus-group-news-1-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-group-news-2-empty-face ((t (nil)))) (gnus-group-news-2-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-group-news-low-empty-face ((t (nil)))) (gnus-group-news-low-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-header-content-face ((t (:background "black" :foreground "springgreen")))) (gnus-header-from-face ((t (nil)))) (gnus-header-name-face ((t (nil)))) (gnus-header-newsgroups-face ((t (nil)))) (gnus-header-subject-face ((t (nil)))) (gnus-server-agent-face ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) (gnus-server-closed-face ((t (:italic t :foreground "Light Steel Blue" :slant italic)))) (gnus-server-denied-face ((t (:bold t :foreground "Pink" :weight semi-bold)))) (gnus-server-offline-face ((t (:bold t :foreground "Yellow" :weight bold)))) (gnus-server-opened-face ((t (:bold t :foreground "Green1" :weight semi-bold)))) (gnus-signature-face ((t (:background "black" :foreground "springgreen" :slant normal)))) (gnus-splash-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-summary-cancelled-face ((t (:foreground "#00CC00" :background "black" :strike-through t)))) (gnus-summary-high-ancient-face ((t (nil)))) (gnus-summary-high-read-face ((t (nil)))) (gnus-summary-high-ticked-face ((t (:background "black" :foreground "seagreen")))) (gnus-summary-high-undownloaded-face ((t (:bold t :foreground "LightGray" :weight bold)))) (gnus-summary-high-unread-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-summary-low-ancient-face ((t (nil)))) (gnus-summary-low-read-face ((t (nil)))) (gnus-summary-low-ticked-face ((t (nil)))) (gnus-summary-low-undownloaded-face ((t (:italic t :foreground "LightGray" :slant italic :weight normal)))) (gnus-summary-low-unread-face ((t (:bold t :foreground "#00CC00" :background "black" :weight bold)))) (gnus-summary-normal-ancient-face ((t (nil)))) (gnus-summary-normal-read-face ((t (nil)))) (gnus-summary-normal-ticked-face ((t (:bold t :foreground "#00CC00" :background "black")))) (gnus-summary-normal-undownloaded-face ((t (:foreground "LightGray" :weight normal)))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (:background "#101010")))) (gnus-x-face ((t (:background "white" :foreground "black")))) (header-line ((t (nil)))) (highlight ((t (:foreground "#00CC00" :background "darkgreen")))) (ido-first-match-face ((t (:bold t :weight bold)))) (ido-indicator-face ((t (:background "red" :foreground "yellow" :width condensed)))) (ido-only-match-face ((t (:foreground "ForestGreen")))) (ido-subdir-face ((t (:foreground "red")))) (isearch ((t (:background "seagreen" :foreground "black")))) (isearch-lazy-highlight-face ((t (:background "darkseagreen" :foreground "black")))) (italic ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) (menu ((t (:bold t :background "black" :foreground "green" :box (:line-width -1 :color "#606060") :weight semi-bold)))) (message-cited-text-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) (message-header-cc-face ((t (nil)))) (message-header-name-face ((t (nil)))) (message-header-newsgroups-face ((t (:bold t :foreground "#00CC00" :background "black")))) (message-header-other-face ((t (:bold t :foreground "#00CC00" :background "black")))) (message-header-subject-face ((t (:bold t :foreground "#00CC00" :background "black")))) (message-header-to-face ((t (:bold t :foreground "#00CC00" :background "black")))) (message-header-xheader-face ((t (nil)))) (message-mml-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) (message-separator-face ((t (nil)))) (minibuffer-prompt ((t (:background "black" :foreground "seagreen")))) (mode-line ((t (:bold t :background "#404040" :foreground "green" :box (:line-width -1 :color "#606060") :weight semi-bold)))) (mode-line-inactive ((t (:bold t :weight semi-bold :box (:line-width -1 :color "#606060") :foreground "green" :background "#101010")))) (mouse ((t (:background "black")))) (paren-face ((t (:background "black" :foreground "darkgreen")))) (paren-face-match ((t (:background "black" :foreground "springgreen")))) (paren-face-mismatch ((t (:foreground "#00CC00" :background "black" :strike-through t)))) (paren-face-no-match ((t (:background "black" :foreground "red")))) (region ((t (:background "seagreen" :foreground "black")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "darkseagreen" :foreground "black")))) (semantic-dirty-token-face ((t (:background "gray10")))) (semantic-unmatched-syntax-face ((t (:underline "red")))) (sgml-end-tag-face ((t (:foreground "seagreen")))) (sgml-start-tag-face ((t (:foreground "seagreen")))) (tabbar-button-face ((t (:background "black" :foreground "#00cc00" :box (:line-width 2 :color "black" :style released-button))))) (tabbar-default-face ((t (:background "black" :foreground "#00cc00")))) (tabbar-selected-face ((t (:background "black" :foreground "springgreen" :box (:line-width 2 :color "black" :style released-button))))) (tabbar-separator-face ((t (:foreground "#00cc00" :background "black")))) (tabbar-unselected-face ((t (:background "black" :foreground "seagreen" :box (:line-width 2 :color "black" :style pressed-button))))) (tool-bar ((t (:box (:line-width 1 :style released-button))))) (tooltip ((t (nil)))) (trailing-whitespace ((t (:background "lightseagreen" :foreground "black")))) (underline ((t (:foreground "#00CC00" :background "black" :underline t)))) (variable-pitch ((t (:underline nil :foreground "#00CC00" :background "black")))) (widget-button-face ((t (:bold t :foreground "#00CC00" :background "black")))) (widget-button-pressed-face ((t (nil)))) (widget-documentation-face ((t (nil)))) (widget-field-face ((t (:italic t :foreground "#00CC00" :background "black" :slant oblique)))) (widget-inactive-face ((t (nil)))) (widget-single-line-field-face ((t (nil))))))) (defun color-theme-matrix () "Color theme by walterh@rocketmail.com, created 2003-10-16." (interactive) (color-theme-install '(color-theme-matrix ((background-color . "black") (background-mode . dark) (background-toolbar-color . "bisque") (border-color . "orange") (bottom-toolbar-shadow-color . "#909099999999") (cursor-color . "#7eff00") (foreground-color . "#7eff00") (mouse-color . "#7eff00") (top-toolbar-shadow-color . "#ffffffffffff")) ((help-highlight-face . underline) (list-matching-lines-face . bold) (rmail-highlight-face . font-lock-function-name-face) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "black" :foreground "#7eff00" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 90 :width normal :family "outline-courier new")))) (Buffer-menu-buffer-face ((t (nil)))) (CUA-global-mark-face ((t (nil)))) (CUA-rectangle-face ((t (nil)))) (CUA-rectangle-noselect-face ((t (nil)))) (Info-title-1-face ((t (nil)))) (Info-title-2-face ((t (nil)))) (Info-title-3-face ((t (nil)))) (Info-title-4-face ((t (nil)))) (antlr-font-lock-keyword-face ((t (nil)))) (antlr-font-lock-literal-face ((t (nil)))) (antlr-font-lock-ruledef-face ((t (nil)))) (antlr-font-lock-ruleref-face ((t (nil)))) (antlr-font-lock-tokendef-face ((t (nil)))) (antlr-font-lock-tokenref-face ((t (nil)))) (bbdb-company ((t (nil)))) (bbdb-field-name ((t (nil)))) (bbdb-field-value ((t (nil)))) (bbdb-name ((t (nil)))) (bg:erc-color-face0 ((t (nil)))) (bg:erc-color-face1 ((t (nil)))) (bg:erc-color-face10 ((t (nil)))) (bg:erc-color-face11 ((t (nil)))) (bg:erc-color-face12 ((t (nil)))) (bg:erc-color-face13 ((t (nil)))) (bg:erc-color-face14 ((t (nil)))) (bg:erc-color-face15 ((t (nil)))) (bg:erc-color-face2 ((t (nil)))) (bg:erc-color-face3 ((t (nil)))) (bg:erc-color-face4 ((t (nil)))) (bg:erc-color-face5 ((t (nil)))) (bg:erc-color-face6 ((t (nil)))) (bg:erc-color-face7 ((t (nil)))) (bg:erc-color-face8 ((t (nil)))) (bg:erc-color-face9 ((t (nil)))) (blank-space-face ((t (nil)))) (blank-tab-face ((t (nil)))) (blue ((t (nil)))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:bold t :weight bold)))) (border ((t (:background "orange")))) (border-glyph ((t (nil)))) (buffers-tab ((t (nil)))) (button ((t (nil)))) (calendar-today-face ((t (nil)))) (change-log-acknowledgement-face ((t (nil)))) (change-log-conditionals-face ((t (nil)))) (change-log-date-face ((t (nil)))) (change-log-email-face ((t (nil)))) (change-log-file-face ((t (nil)))) (change-log-function-face ((t (nil)))) (change-log-list-face ((t (nil)))) (change-log-name-face ((t (nil)))) (clearcase-dired-checkedout-face ((t (nil)))) (comint-highlight-input ((t (nil)))) (comint-highlight-prompt ((t (nil)))) (cparen-around-andor-face ((t (nil)))) (cparen-around-begin-face ((t (nil)))) (cparen-around-conditional-face ((t (nil)))) (cparen-around-define-face ((t (nil)))) (cparen-around-lambda-face ((t (nil)))) (cparen-around-letdo-face ((t (nil)))) (cparen-around-quote-face ((t (nil)))) (cparen-around-set!-face ((t (nil)))) (cparen-around-syntax-rules-face ((t (nil)))) (cparen-around-vector-face ((t (nil)))) (cparen-binding-face ((t (nil)))) (cparen-binding-list-face ((t (nil)))) (cparen-conditional-clause-face ((t (nil)))) (cparen-normal-paren-face ((t (nil)))) (cperl-array-face ((t (nil)))) (cperl-hash-face ((t (nil)))) (cperl-invalid-face ((t (nil)))) (cperl-nonoverridable-face ((t (nil)))) (cursor ((t (:background "#7eff00" :foreground "black")))) (custom-button-face ((t (nil)))) (custom-button-pressed-face ((t (nil)))) (custom-changed-face ((t (nil)))) (custom-comment-face ((t (nil)))) (custom-comment-tag-face ((t (nil)))) (custom-documentation-face ((t (nil)))) (custom-face-tag-face ((t (nil)))) (custom-group-tag-face ((t (nil)))) (custom-group-tag-face-1 ((t (nil)))) (custom-invalid-face ((t (nil)))) (custom-modified-face ((t (nil)))) (custom-rogue-face ((t (nil)))) (custom-saved-face ((t (nil)))) (custom-set-face ((t (nil)))) (custom-state-face ((t (nil)))) (custom-variable-button-face ((t (nil)))) (custom-variable-tag-face ((t (nil)))) (cvs-filename-face ((t (nil)))) (cvs-handled-face ((t (nil)))) (cvs-header-face ((t (nil)))) (cvs-marked-face ((t (nil)))) (cvs-msg-face ((t (nil)))) (cvs-need-action-face ((t (nil)))) (cvs-unknown-face ((t (nil)))) (cyan ((t (nil)))) (diary-face ((t (nil)))) (diff-added-face ((t (nil)))) (diff-changed-face ((t (nil)))) (diff-context-face ((t (nil)))) (diff-file-header-face ((t (nil)))) (diff-function-face ((t (nil)))) (diff-header-face ((t (nil)))) (diff-hunk-header-face ((t (nil)))) (diff-index-face ((t (nil)))) (diff-nonexistent-face ((t (nil)))) (diff-removed-face ((t (nil)))) (dired-face-boring ((t (nil)))) (dired-face-directory ((t (nil)))) (dired-face-executable ((t (nil)))) (dired-face-flagged ((t (nil)))) (dired-face-header ((t (nil)))) (dired-face-marked ((t (nil)))) (dired-face-permissions ((t (nil)))) (dired-face-setuid ((t (nil)))) (dired-face-socket ((t (nil)))) (dired-face-symlink ((t (nil)))) (display-time-mail-balloon-enhance-face ((t (nil)))) (display-time-mail-balloon-gnus-group-face ((t (nil)))) (display-time-time-balloon-face ((t (nil)))) (ebrowse-default-face ((t (nil)))) (ebrowse-file-name-face ((t (nil)))) (ebrowse-member-attribute-face ((t (nil)))) (ebrowse-member-class-face ((t (nil)))) (ebrowse-progress-face ((t (nil)))) (ebrowse-root-class-face ((t (nil)))) (ebrowse-tree-mark-face ((t (nil)))) (ecb-sources-face ((t (nil)))) (edb-inter-field-face ((t (nil)))) (edb-normal-summary-face ((t (nil)))) (ediff-current-diff-face-A ((t (nil)))) (ediff-current-diff-face-Ancestor ((t (nil)))) (ediff-current-diff-face-B ((t (nil)))) (ediff-current-diff-face-C ((t (nil)))) (ediff-even-diff-face-A ((t (nil)))) (ediff-even-diff-face-Ancestor ((t (nil)))) (ediff-even-diff-face-B ((t (nil)))) (ediff-even-diff-face-C ((t (nil)))) (ediff-fine-diff-face-A ((t (nil)))) (ediff-fine-diff-face-Ancestor ((t (nil)))) (ediff-fine-diff-face-B ((t (nil)))) (ediff-fine-diff-face-C ((t (nil)))) (ediff-odd-diff-face-A ((t (nil)))) (ediff-odd-diff-face-Ancestor ((t (nil)))) (ediff-odd-diff-face-B ((t (nil)))) (ediff-odd-diff-face-C ((t (nil)))) (eieio-custom-slot-tag-face ((t (nil)))) (emacs-wiki-bad-link-face ((t (nil)))) (emacs-wiki-link-face ((t (nil)))) (erc-action-face ((t (nil)))) (erc-bold-face ((t (nil)))) (erc-current-nick-face ((t (nil)))) (erc-dangerous-host-face ((t (nil)))) (erc-default-face ((t (nil)))) (erc-direct-msg-face ((t (nil)))) (erc-error-face ((t (nil)))) (erc-fool-face ((t (nil)))) (erc-highlight-face ((t (nil)))) (erc-input-face ((t (nil)))) (erc-inverse-face ((t (nil)))) (erc-keyword-face ((t (nil)))) (erc-nick-default-face ((t (nil)))) (erc-nick-msg-face ((t (nil)))) (erc-notice-face ((t (nil)))) (erc-pal-face ((t (nil)))) (erc-prompt-face ((t (nil)))) (erc-timestamp-face ((t (nil)))) (erc-underline-face ((t (nil)))) (eshell-ls-archive-face ((t (nil)))) (eshell-ls-backup-face ((t (nil)))) (eshell-ls-clutter-face ((t (nil)))) (eshell-ls-directory-face ((t (nil)))) (eshell-ls-executable-face ((t (nil)))) (eshell-ls-missing-face ((t (nil)))) (eshell-ls-picture-face ((t (nil)))) (eshell-ls-product-face ((t (nil)))) (eshell-ls-readonly-face ((t (nil)))) (eshell-ls-special-face ((t (nil)))) (eshell-ls-symlink-face ((t (nil)))) (eshell-ls-text-face ((t (nil)))) (eshell-ls-todo-face ((t (nil)))) (eshell-ls-unreadable-face ((t (nil)))) (eshell-prompt-face ((t (nil)))) (eshell-test-failed-face ((t (nil)))) (eshell-test-ok-face ((t (nil)))) (excerpt ((t (nil)))) (extra-whitespace-face ((t (nil)))) (ff-paths-non-existant-file-face ((t (nil)))) (fg:black ((t (nil)))) (fg:erc-color-face0 ((t (nil)))) (fg:erc-color-face1 ((t (nil)))) (fg:erc-color-face10 ((t (nil)))) (fg:erc-color-face11 ((t (nil)))) (fg:erc-color-face12 ((t (nil)))) (fg:erc-color-face13 ((t (nil)))) (fg:erc-color-face14 ((t (nil)))) (fg:erc-color-face15 ((t (nil)))) (fg:erc-color-face2 ((t (nil)))) (fg:erc-color-face3 ((t (nil)))) (fg:erc-color-face4 ((t (nil)))) (fg:erc-color-face5 ((t (nil)))) (fg:erc-color-face6 ((t (nil)))) (fg:erc-color-face7 ((t (nil)))) (fg:erc-color-face8 ((t (nil)))) (fg:erc-color-face9 ((t (nil)))) (fixed ((t (nil)))) (fixed-pitch ((t (nil)))) (fl-comment-face ((t (nil)))) (fl-function-name-face ((t (nil)))) (fl-keyword-face ((t (nil)))) (fl-string-face ((t (nil)))) (fl-type-face ((t (nil)))) (flash-paren-face-off ((t (nil)))) (flash-paren-face-on ((t (nil)))) (flash-paren-face-region ((t (nil)))) (flyspell-duplicate-face ((t (nil)))) (flyspell-incorrect-face ((t (nil)))) (font-latex-bold-face ((t (nil)))) (font-latex-italic-face ((t (nil)))) (font-latex-math-face ((t (nil)))) (font-latex-sedate-face ((t (nil)))) (font-latex-string-face ((t (nil)))) (font-latex-warning-face ((t (nil)))) (font-lock-builtin-face ((t (:foreground "pink2")))) (font-lock-comment-face ((t (:italic t :background "black" :slant italic)))) (font-lock-constant-face ((t (:foreground "magenta")))) (font-lock-doc-face ((t (nil)))) (font-lock-doc-string-face ((t (nil)))) (font-lock-exit-face ((t (nil)))) (font-lock-function-name-face ((t (:bold t :underline t :weight bold)))) (font-lock-keyword-face ((t (:foreground "yellow1")))) (font-lock-other-emphasized-face ((t (nil)))) (font-lock-other-type-face ((t (nil)))) (font-lock-preprocessor-face ((t (nil)))) (font-lock-reference-face ((t (nil)))) (font-lock-special-comment-face ((t (nil)))) (font-lock-special-keyword-face ((t (nil)))) (font-lock-string-face ((t (:foreground "yellow2")))) (font-lock-type-face ((t (:foreground "LightYellow1")))) (font-lock-variable-name-face ((t (:foreground "light green")))) (font-lock-warning-face ((t (nil)))) (fringe ((t (nil)))) (gnus-cite-attribution-face ((t (nil)))) (gnus-cite-face-1 ((t (nil)))) (gnus-cite-face-10 ((t (nil)))) (gnus-cite-face-11 ((t (nil)))) (gnus-cite-face-2 ((t (nil)))) (gnus-cite-face-3 ((t (nil)))) (gnus-cite-face-4 ((t (nil)))) (gnus-cite-face-5 ((t (nil)))) (gnus-cite-face-6 ((t (nil)))) (gnus-cite-face-7 ((t (nil)))) (gnus-cite-face-8 ((t (nil)))) (gnus-cite-face-9 ((t (nil)))) (gnus-emphasis-bold ((t (nil)))) (gnus-emphasis-bold-italic ((t (nil)))) (gnus-emphasis-highlight-words ((t (nil)))) (gnus-emphasis-italic ((t (nil)))) (gnus-emphasis-strikethru ((t (nil)))) (gnus-emphasis-underline ((t (nil)))) (gnus-emphasis-underline-bold ((t (nil)))) (gnus-emphasis-underline-bold-italic ((t (nil)))) (gnus-emphasis-underline-italic ((t (nil)))) (gnus-filterhist-face-1 ((t (nil)))) (gnus-group-mail-1-empty-face ((t (nil)))) (gnus-group-mail-1-face ((t (nil)))) (gnus-group-mail-2-empty-face ((t (nil)))) (gnus-group-mail-2-face ((t (nil)))) (gnus-group-mail-3-empty-face ((t (nil)))) (gnus-group-mail-3-face ((t (nil)))) (gnus-group-mail-low-empty-face ((t (nil)))) (gnus-group-mail-low-face ((t (nil)))) (gnus-group-news-1-empty-face ((t (nil)))) (gnus-group-news-1-face ((t (nil)))) (gnus-group-news-2-empty-face ((t (nil)))) (gnus-group-news-2-face ((t (nil)))) (gnus-group-news-3-empty-face ((t (nil)))) (gnus-group-news-3-face ((t (nil)))) (gnus-group-news-4-empty-face ((t (nil)))) (gnus-group-news-4-face ((t (nil)))) (gnus-group-news-5-empty-face ((t (nil)))) (gnus-group-news-5-face ((t (nil)))) (gnus-group-news-6-empty-face ((t (nil)))) (gnus-group-news-6-face ((t (nil)))) (gnus-group-news-low-empty-face ((t (nil)))) (gnus-group-news-low-face ((t (nil)))) (gnus-header-content-face ((t (nil)))) (gnus-header-from-face ((t (nil)))) (gnus-header-name-face ((t (nil)))) (gnus-header-newsgroups-face ((t (nil)))) (gnus-header-subject-face ((t (nil)))) (gnus-picon-face ((t (nil)))) (gnus-picon-xbm-face ((t (nil)))) (gnus-picons-face ((t (nil)))) (gnus-picons-xbm-face ((t (nil)))) (gnus-server-agent-face ((t (nil)))) (gnus-server-closed-face ((t (nil)))) (gnus-server-denied-face ((t (nil)))) (gnus-server-offline-face ((t (nil)))) (gnus-server-opened-face ((t (nil)))) (gnus-signature-face ((t (nil)))) (gnus-splash ((t (nil)))) (gnus-splash-face ((t (nil)))) (gnus-summary-cancelled-face ((t (nil)))) (gnus-summary-high-ancient-face ((t (nil)))) (gnus-summary-high-read-face ((t (nil)))) (gnus-summary-high-ticked-face ((t (nil)))) (gnus-summary-high-undownloaded-face ((t (nil)))) (gnus-summary-high-unread-face ((t (nil)))) (gnus-summary-low-ancient-face ((t (nil)))) (gnus-summary-low-read-face ((t (nil)))) (gnus-summary-low-ticked-face ((t (nil)))) (gnus-summary-low-undownloaded-face ((t (nil)))) (gnus-summary-low-unread-face ((t (nil)))) (gnus-summary-normal-ancient-face ((t (nil)))) (gnus-summary-normal-read-face ((t (nil)))) (gnus-summary-normal-ticked-face ((t (nil)))) (gnus-summary-normal-undownloaded-face ((t (nil)))) (gnus-summary-normal-unread-face ((t (nil)))) (gnus-summary-selected-face ((t (nil)))) (gnus-x-face ((t (nil)))) (green ((t (nil)))) (gui-button-face ((t (nil)))) (gui-element ((t (nil)))) (header-line ((t (nil)))) (hi-black-b ((t (nil)))) (hi-black-hb ((t (nil)))) (hi-blue ((t (nil)))) (hi-blue-b ((t (nil)))) (hi-green ((t (nil)))) (hi-green-b ((t (nil)))) (hi-pink ((t (nil)))) (hi-red-b ((t (nil)))) (hi-yellow ((t (nil)))) (highlight ((t (:background "#7eff00" :foreground "black")))) (highlight-changes-delete-face ((t (nil)))) (highlight-changes-face ((t (nil)))) (highline-face ((t (nil)))) (holiday-face ((t (nil)))) (html-helper-bold-face ((t (nil)))) (html-helper-bold-italic-face ((t (nil)))) (html-helper-builtin-face ((t (nil)))) (html-helper-italic-face ((t (nil)))) (html-helper-underline-face ((t (nil)))) (html-tag-face ((t (nil)))) (hyper-apropos-documentation ((t (nil)))) (hyper-apropos-heading ((t (nil)))) (hyper-apropos-hyperlink ((t (nil)))) (hyper-apropos-major-heading ((t (nil)))) (hyper-apropos-section-heading ((t (nil)))) (hyper-apropos-warning ((t (nil)))) (ibuffer-deletion-face ((t (nil)))) (ibuffer-marked-face ((t (nil)))) (idlwave-help-link-face ((t (nil)))) (idlwave-shell-bp-face ((t (nil)))) (ido-first-match-face ((t (nil)))) (ido-indicator-face ((t (nil)))) (ido-only-match-face ((t (nil)))) (ido-subdir-face ((t (nil)))) (info-header-node ((t (nil)))) (info-header-xref ((t (nil)))) (info-menu-5 ((t (nil)))) (info-menu-6 ((t (nil)))) (info-menu-header ((t (nil)))) (info-node ((t (nil)))) (info-xref ((t (nil)))) (isearch ((t (nil)))) (isearch-lazy-highlight-face ((t (nil)))) (isearch-secondary ((t (nil)))) (italic ((t (:underline t)))) (jde-bug-breakpoint-cursor ((t (nil)))) (jde-bug-breakpoint-marker ((t (nil)))) (jde-db-active-breakpoint-face ((t (nil)))) (jde-db-requested-breakpoint-face ((t (nil)))) (jde-db-spec-breakpoint-face ((t (nil)))) (jde-java-font-lock-api-face ((t (nil)))) (jde-java-font-lock-bold-face ((t (nil)))) (jde-java-font-lock-code-face ((t (nil)))) (jde-java-font-lock-constant-face ((t (nil)))) (jde-java-font-lock-doc-tag-face ((t (nil)))) (jde-java-font-lock-italic-face ((t (nil)))) (jde-java-font-lock-link-face ((t (nil)))) (jde-java-font-lock-modifier-face ((t (nil)))) (jde-java-font-lock-number-face ((t (nil)))) (jde-java-font-lock-operator-face ((t (nil)))) (jde-java-font-lock-package-face ((t (nil)))) (jde-java-font-lock-pre-face ((t (nil)))) (jde-java-font-lock-underline-face ((t (nil)))) (lazy-highlight-face ((t (nil)))) (left-margin ((t (nil)))) (linemenu-face ((t (nil)))) (list-mode-item-selected ((t (nil)))) (log-view-file-face ((t (nil)))) (log-view-message-face ((t (nil)))) (magenta ((t (nil)))) (makefile-space-face ((t (nil)))) (man-bold ((t (nil)))) (man-heading ((t (nil)))) (man-italic ((t (nil)))) (man-xref ((t (nil)))) (menu ((t (nil)))) (message-cited-text ((t (nil)))) (message-cited-text-face ((t (nil)))) (message-header-cc-face ((t (nil)))) (message-header-contents ((t (nil)))) (message-header-name-face ((t (nil)))) (message-header-newsgroups-face ((t (nil)))) (message-header-other-face ((t (nil)))) (message-header-subject-face ((t (nil)))) (message-header-to-face ((t (nil)))) (message-header-xheader-face ((t (nil)))) (message-headers ((t (nil)))) (message-highlighted-header-contents ((t (nil)))) (message-mml-face ((t (nil)))) (message-separator-face ((t (nil)))) (message-url ((t (nil)))) (minibuffer-prompt ((t (nil)))) (mmm-face ((t (nil)))) (mode-line ((t (:bold t :background "gray" :foreground "black" :weight bold)))) (mode-line-inactive ((t (nil)))) (modeline-buffer-id ((t (:background "orange" :foreground "black")))) (modeline-mousable ((t (:background "orange" :foreground "black")))) (modeline-mousable-minor-mode ((t (:background "orange" :foreground "black")))) (mouse ((t (nil)))) (mpg123-face-cur ((t (nil)))) (mpg123-face-slider ((t (nil)))) (my-tab-face ((t (nil)))) (nil ((t (nil)))) (overlay-empty-face ((t (nil)))) (p4-diff-del-face ((t (nil)))) (paren-blink-off ((t (nil)))) (paren-face ((t (nil)))) (paren-face-match ((t (nil)))) (paren-face-mismatch ((t (nil)))) (paren-face-no-match ((t (nil)))) (paren-match ((t (nil)))) (paren-mismatch ((t (nil)))) (paren-mismatch-face ((t (nil)))) (paren-no-match-face ((t (nil)))) (pointer ((t (nil)))) (primary-selection ((t (nil)))) (reb-match-0 ((t (nil)))) (reb-match-1 ((t (nil)))) (reb-match-2 ((t (nil)))) (reb-match-3 ((t (nil)))) (red ((t (nil)))) (region ((t (:background "#7eff00" :foreground "black")))) (right-margin ((t (nil)))) (rpm-spec-dir-face ((t (nil)))) (rpm-spec-doc-face ((t (nil)))) (rpm-spec-ghost-face ((t (nil)))) (rpm-spec-macro-face ((t (nil)))) (rpm-spec-package-face ((t (nil)))) (rpm-spec-tag-face ((t (nil)))) (rpm-spec-var-face ((t (nil)))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "orange" :foreground "black")))) (semantic-dirty-token-face ((t (nil)))) (semantic-intangible-face ((t (nil)))) (semantic-read-only-face ((t (nil)))) (semantic-unmatched-syntax-face ((t (nil)))) (senator-intangible-face ((t (nil)))) (senator-momentary-highlight-face ((t (nil)))) (senator-read-only-face ((t (nil)))) (sgml-comment-face ((t (nil)))) (sgml-doctype-face ((t (nil)))) (sgml-end-tag-face ((t (nil)))) (sgml-entity-face ((t (nil)))) (sgml-ignored-face ((t (nil)))) (sgml-ms-end-face ((t (nil)))) (sgml-ms-start-face ((t (nil)))) (sgml-pi-face ((t (nil)))) (sgml-sgml-face ((t (nil)))) (sgml-short-ref-face ((t (nil)))) (sgml-shortref-face ((t (nil)))) (sgml-start-tag-face ((t (nil)))) (sh-heredoc-face ((t (nil)))) (shell-option-face ((t (nil)))) (shell-output-2-face ((t (nil)))) (shell-output-3-face ((t (nil)))) (shell-output-face ((t (nil)))) (shell-prompt-face ((t (nil)))) (show-block-face1 ((t (nil)))) (show-block-face2 ((t (nil)))) (show-block-face3 ((t (nil)))) (show-block-face4 ((t (nil)))) (show-block-face5 ((t (nil)))) (show-block-face6 ((t (nil)))) (show-block-face7 ((t (nil)))) (show-block-face8 ((t (nil)))) (show-block-face9 ((t (nil)))) (show-paren-match-face ((t (:background "orange" :foreground "black")))) (show-paren-mismatch-face ((t (:underline t)))) (show-tabs-space-face ((t (nil)))) (show-tabs-tab-face ((t (nil)))) (smerge-base-face ((t (nil)))) (smerge-markers-face ((t (nil)))) (smerge-mine-face ((t (nil)))) (smerge-other-face ((t (nil)))) (speedbar-button-face ((t (nil)))) (speedbar-directory-face ((t (nil)))) (speedbar-file-face ((t (nil)))) (speedbar-highlight-face ((t (nil)))) (speedbar-selected-face ((t (nil)))) (speedbar-separator-face ((t (nil)))) (speedbar-tag-face ((t (nil)))) (strokes-char-face ((t (nil)))) (swbuff-current-buffer-face ((t (nil)))) (tabbar-button-face ((t (nil)))) (tabbar-default-face ((t (nil)))) (tabbar-selected-face ((t (nil)))) (tabbar-separator-face ((t (nil)))) (tabbar-unselected-face ((t (nil)))) (template-message-face ((t (nil)))) (term-black ((t (nil)))) (term-blackbg ((t (nil)))) (term-blue ((t (nil)))) (term-blue-bold-face ((t (nil)))) (term-blue-face ((t (nil)))) (term-blue-inv-face ((t (nil)))) (term-blue-ul-face ((t (nil)))) (term-bluebg ((t (nil)))) (term-bold ((t (nil)))) (term-cyan ((t (nil)))) (term-cyan-bold-face ((t (nil)))) (term-cyan-face ((t (nil)))) (term-cyan-inv-face ((t (nil)))) (term-cyan-ul-face ((t (nil)))) (term-cyanbg ((t (nil)))) (term-default ((t (nil)))) (term-default-bg ((t (nil)))) (term-default-bg-inv ((t (nil)))) (term-default-bold-face ((t (nil)))) (term-default-face ((t (nil)))) (term-default-fg ((t (nil)))) (term-default-fg-inv ((t (nil)))) (term-default-inv-face ((t (nil)))) (term-default-ul-face ((t (nil)))) (term-green ((t (nil)))) (term-green-bold-face ((t (nil)))) (term-green-face ((t (nil)))) (term-green-inv-face ((t (nil)))) (term-green-ul-face ((t (nil)))) (term-greenbg ((t (nil)))) (term-invisible ((t (nil)))) (term-invisible-inv ((t (nil)))) (term-magenta ((t (nil)))) (term-magenta-bold-face ((t (nil)))) (term-magenta-face ((t (nil)))) (term-magenta-inv-face ((t (nil)))) (term-magenta-ul-face ((t (nil)))) (term-magentabg ((t (nil)))) (term-red ((t (nil)))) (term-red-bold-face ((t (nil)))) (term-red-face ((t (nil)))) (term-red-inv-face ((t (nil)))) (term-red-ul-face ((t (nil)))) (term-redbg ((t (nil)))) (term-underline ((t (nil)))) (term-white ((t (nil)))) (term-white-bold-face ((t (nil)))) (term-white-face ((t (nil)))) (term-white-inv-face ((t (nil)))) (term-white-ul-face ((t (nil)))) (term-whitebg ((t (nil)))) (term-yellow ((t (nil)))) (term-yellow-bold-face ((t (nil)))) (term-yellow-face ((t (nil)))) (term-yellow-inv-face ((t (nil)))) (term-yellow-ul-face ((t (nil)))) (term-yellowbg ((t (nil)))) (tex-math-face ((t (nil)))) (texinfo-heading-face ((t (nil)))) (text-cursor ((t (nil)))) (tool-bar ((t (nil)))) (tooltip ((t (nil)))) (trailing-whitespace ((t (nil)))) (underline ((t (:underline t)))) (variable-pitch ((t (nil)))) (vc-annotate-face-0046FF ((t (nil)))) (vcursor ((t (nil)))) (vertical-divider ((t (nil)))) (vhdl-font-lock-attribute-face ((t (nil)))) (vhdl-font-lock-directive-face ((t (nil)))) (vhdl-font-lock-enumvalue-face ((t (nil)))) (vhdl-font-lock-function-face ((t (nil)))) (vhdl-font-lock-generic-/constant-face ((t (nil)))) (vhdl-font-lock-prompt-face ((t (nil)))) (vhdl-font-lock-reserved-words-face ((t (nil)))) (vhdl-font-lock-translate-off-face ((t (nil)))) (vhdl-font-lock-type-face ((t (nil)))) (vhdl-font-lock-variable-face ((t (nil)))) (vhdl-speedbar-architecture-face ((t (nil)))) (vhdl-speedbar-architecture-selected-face ((t (nil)))) (vhdl-speedbar-configuration-face ((t (nil)))) (vhdl-speedbar-configuration-selected-face ((t (nil)))) (vhdl-speedbar-entity-face ((t (nil)))) (vhdl-speedbar-entity-selected-face ((t (nil)))) (vhdl-speedbar-instantiation-face ((t (nil)))) (vhdl-speedbar-instantiation-selected-face ((t (nil)))) (vhdl-speedbar-package-face ((t (nil)))) (vhdl-speedbar-package-selected-face ((t (nil)))) (vhdl-speedbar-subprogram-face ((t (nil)))) (viper-minibuffer-emacs-face ((t (nil)))) (viper-minibuffer-insert-face ((t (nil)))) (viper-minibuffer-vi-face ((t (nil)))) (viper-replace-overlay-face ((t (nil)))) (viper-search-face ((t (nil)))) (vm-xface ((t (nil)))) (vmpc-pre-sig-face ((t (nil)))) (vmpc-sig-face ((t (nil)))) (w3m-anchor-face ((t (nil)))) (w3m-arrived-anchor-face ((t (nil)))) (w3m-header-line-location-content-face ((t (nil)))) (w3m-header-line-location-title-face ((t (nil)))) (white ((t (nil)))) (widget ((t (nil)))) (widget-button-face ((t (nil)))) (widget-button-pressed-face ((t (nil)))) (widget-documentation-face ((t (nil)))) (widget-field-face ((t (nil)))) (widget-inactive-face ((t (nil)))) (widget-single-line-field-face ((t (nil)))) (woman-addition-face ((t (nil)))) (woman-bold-face ((t (nil)))) (woman-italic-face ((t (nil)))) (woman-unknown-face ((t (nil)))) (x-face ((t (nil)))) (xrdb-option-name-face ((t (nil)))) (xref-keyword-face ((t (nil)))) (xref-list-default-face ((t (nil)))) (xref-list-pilot-face ((t (nil)))) (xref-list-symbol-face ((t (nil)))) (yellow ((t (nil)))) (zmacs-region ((t (nil))))))) (defun color-theme-feng-shui () "Color theme by walterh@rocketmail.com (www.xanadb.com), created 2003-10-16. Evolved from color-theme-katester" (interactive) (color-theme-install '(color-theme-feng-shui ((background-color . "ivory") (background-mode . light) (border-color . "black") (cursor-color . "slateblue") (foreground-color . "black") (mouse-color . "slateblue")) ((help-highlight-face . underline) (list-matching-lines-face . bold) (view-highlight-face . highlight) (widget-mouse-face . highlight)) (default ((t (:stipple nil :background "ivory" :foreground "black" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 90 :width normal :family "outline-courier new")))) (bold ((t (:bold t :weight bold)))) (bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) (border ((t (:background "black")))) (cursor ((t (:background "slateblue" :foreground "black")))) (fixed-pitch ((t (:family "courier")))) (font-lock-builtin-face ((t (:foreground "black")))) (font-lock-comment-face ((t (:italic t :background "seashell" :slant italic)))) (font-lock-constant-face ((t (:foreground "darkblue")))) (font-lock-doc-face ((t (:background "lemonChiffon")))) (font-lock-function-name-face ((t (:bold t :underline t :weight bold)))) (font-lock-keyword-face ((t (:foreground "blue")))) (font-lock-string-face ((t (:background "lemonChiffon")))) (font-lock-type-face ((t (:foreground "black")))) (font-lock-variable-name-face ((t (:foreground "black")))) (font-lock-warning-face ((t (:bold t :foreground "Red" :weight bold)))) (fringe ((t (:background "grey95")))) (header-line ((t (:bold t :weight bold :underline t :background "grey90" :foreground "grey20" :box nil)))) (highlight ((t (:background "mistyRose" :foreground "black")))) (isearch ((t (:background "magenta4" :foreground "lightskyblue1")))) (isearch-lazy-highlight-face ((t (:background "paleturquoise")))) (italic ((t (:italic t :slant italic)))) (menu ((t (nil)))) (mode-line ((t (:bold t :background "mistyRose" :foreground "navy" :underline t :weight bold)))) (mouse ((t (:background "slateblue")))) (region ((t (:background "lavender" :foreground "black")))) (scroll-bar ((t (nil)))) (secondary-selection ((t (:background "yellow")))) (tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv")))) (widget-button-face ((t (:bold t :weight bold)))) (widget-button-pressed-face ((t (:foreground "red")))) (widget-documentation-face ((t (:foreground "dark green")))) (widget-field-face ((t (:background "gray85")))) (widget-inactive-face ((t (:foreground "dim gray")))) (widget-single-line-field-face ((t (:background "gray85"))))))) (defun color-theme-renegade () "Renegade BBS styled color theme. Works well in X and terminals. Created by Dave Benjamin Dec 23 2005." (interactive) (color-theme-install '(color-theme-renegade ((background-color . "black") (background-mode . dark) (border-color . "black") (cursor-color . "black") (foreground-color . "cyan3") (mouse-color . "white")) (default ((t (nil)))) (bold ((t (:bold t :foreground "cyan" :weight bold)))) (bold-italic ((t (:italic t :bold t :foreground "cyan" :slant italic :weight bold)))) (fixed-pitch ((t (:family "courier")))) (font-lock-builtin-face ((t (:bold t :foreground "cornflower blue" :weight bold)))) (font-lock-comment-face ((t (:bold t :foreground "yellow" :weight bold)))) (font-lock-constant-face ((t (:foreground "magenta3")))) (font-lock-doc-face ((t (:bold t :weight bold :foreground "red")))) (font-lock-function-name-face ((t (:foreground "gray")))) (font-lock-keyword-face ((t (:bold t :foreground "cyan" :weight bold)))) (font-lock-string-face ((t (:bold t :foreground "red" :weight bold)))) (font-lock-type-face ((t (:bold t :foreground "cyan" :weight bold)))) (font-lock-variable-name-face ((t (:foreground "cyan3")))) (font-lock-warning-face ((t (:bold t :foreground "red" :weight bold)))) (fringe ((t (:background "gray32")))) (highlight ((t (:background "blue")))) (isearch ((t (:background "blue" :foreground "cyan3")))) (isearch-lazy-highlight-face ((t (:background "turquoise3" :foreground "black")))) (menu ((t (nil)))) (mode-line ((t (:bold t :background "blue3" :foreground "white" :box (:line-width -1 :style released-button) :weight bold)))) (mouse ((t (:background "white")))) (region ((t (:bold t :background "white" :foreground "blue" :weight bold)))) (scroll-bar ((t (nil)))) (trailing-whitespace ((t (:background "red")))) (underline ((t (:underline t)))) (variable-pitch ((t (:family "helv"))))))) ;;; color-theme-library.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/eproject.el0000664000000000000000000006636612230377266021422 0ustar ;;; eproject.el --- assign files to projects, programatically ;; ;; Copyright (C) 2008, 2009 Jonathan Rockway ;; ;; Author: Jonathan Rockway ;; Maintainer: Jonathan Rockway ;; Created: 20 Nov 2008 ;; Version: 1.5 ;; Keywords: programming, projects ;; ;; This file is not a part of GNU Emacs. ;; ;; 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 2 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, write to the Free ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. ;; ;;; Commentary: ;; ;; Eproject is an extension that lets you group related files together ;; as projects. It aims to be as unobtrusive as possible -- no new ;; files are created (or required to exist) on disk, and buffers that ;; aren't a member of a project are not affected in any way. ;; ;; The main starting point for eproject is defining project types. ;; There is a macro for this, define-project-type, that accepts four ;; arguments, the type name (a symbol), a list of supertypes (for ;; inheriting properties), a form that is executed to determine ;; whether a file is a member of a project, and then a free-form ;; property list. An example will clear things up. ;; ;; Let's create a "perl" project type, for Perl projects that have a ;; Makefile.PL. ;; ;; (define-project-type perl (generic) ;; (look-for "Makefile.PL") ;; :relevant-files ("\\.pm$" "\\.t$")) ;; ;; Now when you open a file and somewhere above in the directory tree ;; there is a Makefile.PL, it will be a "perl project". ;; ;; There are a few things you get with this. A hook called ;; perl-project-file-visit-hook will be run, and the buffer will have ;; the "eproject-mode" minor-mode turned on. You can also read and ;; set metadata via the eproject-attribute and ;; eproject-add-project-metadatum calls. ;; ;; (This is mostly helpful to Lisp programmers rather than end-users; ;; if you want tools for visiting and managing projects (and ibuffer ;; integration), load `eproject-extras'. These extras are great ;; examples of the eproject API in action, so please take a look even ;; if you don't want those exact features.) ;; ;; Let's look at the mechanics of the define-project-type call. The ;; first argument is the name of the project type -- it can be any ;; symbol. The next argument is a list of other projects types that ;; this project will inherit from. That means that if you call ;; eproject-get-project-metadatum and the current project doesn't ;; define a value, we'll look at the supertypes until we get something ;; non-nil. Usually you will want to set this to (generic), which ;; will make your type work correctly even if you don't define any of ;; your own metadata. ;; ;; The next argument is a form that will be executed with the filename ;; that was just opened bound to FILE. It is expected to return the ;; project root, or nil if FILE is not in a project of this type. The ;; look-for function will look up the directory tree for a file that ;; is named the same as its argument (see the docstring for ;; `eproject--look-for-impl' for all the details). You can write any ;; Lisp here you like; we'll see some more examples later. (You only ;; get one form, so if you need to execute more than one, just wrap it ;; in a progn.) ;; ;; The final (&rest-style) argument is a property list of initial project ;; metadata. You can put anything you want here, as long as it is in the ;; form of a property list (keyword, value, keyword, value, ...). ;; ;; After this form runs, eproject will be able to recognize files in ;; the type of the project you defined. It also creates a hook named ;; -project-file-visit-hook. You can do anything you want here, ;; including access (eproject-type) and (eproject-root). ;; ;; As an example, in my perl-project-file-visit-hook, I do this: ;; ;; (lambda () ;; (ignore-errors ;; (stylish-repl-eval-perl ;; (format "use lib '%s'" (car (perl-project-includes))))))) ;; ;; This will add the library directory of this project to my current ;; stylish-repl session, so that I can use my project in the REPL ;; immediately. (I do something similar for Lisp + SLIME projects) ;; ;; That's basically all there is. eproject is designed to be minimal and ;; extensible, so I hope it meets your needs. ;; ;; Please e-mail me or find me on #emacs (jrockway) if you have ;; questions. If you'd like to send a patch (always appreciated), ;; please diff against the latest git version, available by running: ;; ;; $ git clone git://github.com/jrockway/eproject ;; ;; Share and enjoy. ;;; Public API: ;; eproject-root (&optional buffer) ;; ;; - returns the project root for the project that buffer is a member ;; of. defaults to the current buffer ;; eproject-attribute (key &optional root) ;; ;; - returns the value of key for the project that buffer is a member ;; of. root defaults to the current buffer's eproject-root ;; eproject-list-project-files ;; define-project-type ;; define-project-attribute ;; eproject-projects ;; Everything else is mostly used internally, and may change. ;;; Public commands: ;; eproject-maybe-turn-on ;; ;; - turn on eproject for the current buffer, if possible ;; (if it's turned on, the hooks will be run) ;; eproject-reinitialize-project ;; ;; - re-read config for the current project, then run ;; eproject-maybe-turn-on ;; ;; this is bound to C-c C-c when editing .eproject files, which is ;; very convenient for testing. ;; See eproject-extras.el for more interesting / useful commands. ;; This file is mostly "plumbing". ;;; Bugs: ;; ;; You can't forward reference supertypes -- this will mess things up ;; internally, but you won't get a warning. This can be easily fixed ;; by using a smarter algorithm for eproject--all-types. ;; ;; The "linearized isa" (i.e. "class precedence list") is computed ;; with a depth-first search. This is bad; we should really use the ;; C3 ordering. ;;; Website: ;; ;; The latest version is on github at ;; http://github.com/jrockway/eproject/tree/master ;; ;; The wiki has lots more documentation: ;; http://wiki.github.com/jrockway/eproject ;; ;;; The Changelog section documents major changes. Minor non-breaking ;;; updates are regularly committed to git. ;;; Changelog: ;; ;; 1.6 (Sat Aug 28 22:21:39 CDT 2010) ;; ;; * Remove eproject-project-names variable and add some proper ;; introspection for project sets. ;; ;; 1.5 (Thu May 28 21:38:08 MST 2009) ;; ;; * Split out the non-core stuff into eproject-extras.el. ;; (slime-contrib style) ;; ;; 1.4 (Thu May 28 02:21:40 MST 2009) ;; ;; * Add support for "instance" metadata, instead of "class" (project) ;; metadata ;; ;; 1.3 (Wed May 27 20:47:48 MST 2009) ;; ;; * Officially support w32 ;; ;; 1.2 (Thu May 7 02:18:01 CDT 2009) ;; ;; * Add ibuffer support ;; ;; 1.1 (Sat Jan 31 20:03:56 CST 2009) ;; ;; * Make the completing-read function customizable ;; ;; 1.0 (Nov 28 2008) ;; ;; * Initial release ;; ;;; Code: (require 'cl) (require 'eshell) ;; For portable path handling (defgroup eproject nil "Eproject; provide support for grouping files and buffers into projects" :prefix "eproject-" :group 'convenience :link '(emacs-commentary-link :tag "Commentary" "eproject.el") :link '(emacs-library-link :tag "Optional extras" "eproject-extras.el") :link '(url-link :tag "Github wiki" "http://wiki.github.com/jrockway/eproject")) (defvar eproject-root nil "A buffer-local variable set to the root of its eproject project. NIL if it isn't in an eproject. Your code should call the function `eproject-root` instead of accessing this variable directly. It should also not set it; only `eproject-maybe-turn-on' can do that.") (make-variable-buffer-local 'eproject-root) (defvar eproject-project-types nil "An alist of project type name to (supertypes selector metadata-plist) pairs.") (defvar eproject-extra-attributes nil "A list of pairs used to assign attributes to projects. Each entry can be in the form of `(FUNCTION (ATTRIBUTES))' or `((KEY . TYPE) (ATTRIBUTES))'. If FUNCTION is specified, it will be evaluated for each project root. If it returns a non-nil value, ATTRIBUTES will be added to the project attributes. If `(KEY . TYPE)' is specified, then TYPE is either `:root-regexp' or `:project-name' and KEY is interpreted accordingly. If KEY matches a project root, its ATTRIBUTES are applied. ATTRIBUTES is a plist of attributes.") (defvar eproject-attributes-alist nil "An alist of project root -> plist of project metadata.") (defvar eproject-first-buffer-hook nil "Hook to run when the first buffer in a new project is opened. Called after the project is initialized, so it's safe to call eproject functions.") (defvar eproject-projects-hook nil "Hook that's run when a list of projects is requested. Hook may return a list of new (name . root) pairs to be added to eproject's internal list.") (defvar eproject-project-change-hook nil "Hook that's run when a project is changed; currently this means when a file in the project is saved.") (defun define-project-attribute (key attributes) "Define extra attributes to be applied to projects. See `eproject-extra-attributes' for details on the format of KEY and ATTRIBUTES." (check-type key (or function cons)) (check-type attributes list) (add-to-list 'eproject-extra-attributes (list key attributes))) (defmacro define-project-type (type supertypes selector &rest metadata) "Define a new project type TYPE that inherits from SUPERTYPES. SELECTOR is a form that is given a filename FILE and returns the project root if it is of this type of project, or NIL otherwise. Optional argument METADATA is a plist of metadata that will become project attributes." `(progn (defvar ,(intern (format "%s-project-file-visit-hook" type)) nil ,(format "Hooks that will be run when a file in a %s project is opened." type)) (setq eproject-project-types (nconc (assq-delete-all ',type eproject-project-types) (list (list ',type ',supertypes (lambda (file) ,selector) ',metadata)))))) (defun eproject--build-parent-candidates (start-at) "Given directory START-AT, return a list of parent directories, including START-AT." (loop for x on (reverse (eshell-split-path start-at)) by #'cdr ;; i think eshell-split-path guarantees the ;; file-name-as-directory application, but i don't want to ;; debug it if it doesn't :) collect (file-name-as-directory (apply #'concat (reverse x))))) (defun eproject--scan-parents-for (start-at predicate) "Call PREDICATE with each parent directory of START-AT, returning the path to the first directory where PREDICATE returns T." (find-if predicate (eproject--build-parent-candidates (file-name-as-directory start-at)))) (defun eproject--find-file-named (start-at filename) "Starting in directory START-AT, recursively check parent directories for a file named FILENAME. Return the directory where the file is first found; return NIL otherwise." (eproject--scan-parents-for start-at (lambda (directory) ; note that directory always has the path separator on the end (file-exists-p (concat directory filename))))) ;; TODO: sugar around lambda/lambda, which is ugly (define-project-type generic () nil :relevant-files (".*") :irrelevant-files ("^[.]" "^[#]") :file-name-map (lambda (root) (lambda (root file) file)) :local-variables (lambda (root) (lambda (root file) nil)) :config-file ".eproject") (define-project-type generic-eproject (generic) (look-for ".eproject")) (define-project-type generic-git (generic) (look-for ".git") :irrelevant-files ("^[.]" "^[#]" ".git/")) (defun eproject--type-info (type) (or (assoc type eproject-project-types) (error "No type %s" type))) (defun eproject--project-supertypes (type) (nth 1 (eproject--type-info type))) (defun eproject--project-selector (type) (nth 2 (eproject--type-info type))) (defun* eproject--look-for-impl (file expression &optional (type :filename)) "Implements the LOOK-FOR function that is flet-bound during `eproject--run-project-selector'. EXPRESSION and TYPE specify what to look for. Some examples: (look-for \"Makefile.PL\") ; look up the directory tree for a file called Makefile.PL (look-for \"*.PL\" :glob) ; look for a file matching *.PL " (case type (:filename (eproject--find-file-named file expression)) (:glob (eproject--scan-parents-for (file-name-directory file) (lambda (current-directory) (let ((default-directory current-directory)) (and (not (equal file current-directory)) (> (length (file-expand-wildcards expression)) 0)))))) (otherwise (error "Don't know how to handle %s in LOOK-FOR!" type)))) (defun eproject--buffer-file-name () (or (buffer-file-name) (and (eq major-mode 'dired-mode) (expand-file-name (if (consp dired-directory) (car dired-directory) dired-directory))))) (defun* eproject--run-project-selector (type &optional (file (eproject--buffer-file-name))) "Run the selector associated with project type TYPE." (when (not file) (error "Buffer '%s' has no file name" (current-buffer))) (flet ((look-for (expr &optional (expr-type :filename)) (funcall #'eproject--look-for-impl file expr expr-type))) (funcall (eproject--project-selector type) file))) (defun eproject--linearized-isa (type &optional include-self) (delete-duplicates (nconc (if include-self (list type)) (eproject--project-supertypes type) (loop for stype in (eproject--project-supertypes type) nconc (eproject--linearized-isa stype))))) (defun eproject--all-types () ;; this should be most specific to least specific, as long as nothing ;; is forward-referenced. (reverse (mapcar #'car eproject-project-types))) ;; metadata vs. attributes: ;; * metadata is per-project-type ;; * attributes are per-project-root (and includes the project-type metadata) (defun eproject--compute-all-applicable-metadata (type) (loop for next-type in (eproject--linearized-isa type t) append (nth 3 (eproject--type-info next-type)))) (defun eproject-get-project-metadatum (type key) (getf (eproject--compute-all-applicable-metadata type) key)) (defun eproject-add-project-metadatum (type key value) (setf (getf (nth 3 (assoc type eproject-project-types)) key) value)) (defmacro* eproject--do-in-buffer ((buffer) &body forms) `(with-current-buffer ,buffer (when (not eproject-mode) (error "Buffer is not an eproject buffer!")) ,@forms)) (defun* eproject-root (&optional (buffer (current-buffer))) "Return the value of the eproject variable root. BUFFER defaults to the current buffer" (eproject--do-in-buffer (buffer) eproject-root)) (defun* eproject-attribute (key &optional (root (eproject-root))) "Lookup the attribute KEY for the eproject ROOT ROOT defaults to the current buffer's project-root." (getf (cdr (assoc root eproject-attributes-alist)) key)) (defun eproject--known-project-roots () "Return a list of projects roots that have been visisted this session." (loop for (key . value) in eproject-attributes-alist collect key)) (defmacro define-eproject-accessor (variable) "Create a function named eproject-VARIABLE that return the value of VARIABLE in the context of the current project." (let ((sym (intern (format "eproject-%s" variable)))) `(defun* ,sym (&optional (buffer (current-buffer))) ,(format "Return the value of the eproject variable %s. BUFFER defaults to the current buffer." variable) (eproject-attribute ,(intern (format ":%s" variable)))))) (define-eproject-accessor type) (define-eproject-accessor name) (defun eproject-reinitialize-project () "Forget all project settings for the current eproject, then reload them." (interactive) (let ((root (eproject-root))) (setf eproject-attributes-alist (delete-if (lambda (x) (equal (car x) root)) eproject-attributes-alist))) (eproject-maybe-turn-on) (if (ignore-errors (eproject-root)) (message "Project `%s' reinitialized successfully." (eproject-name)) (message "Error reinitializing project!"))) (defun eproject--maybe-reinitialize () "Run by `eproject-project-change-hook' to reinit the project after .eproject is modified." (when (and (eq major-mode 'dot-eproject-mode) (boundp 'eproject-root) eproject-root) (eproject-reinitialize-project))) (defun eproject--eval-user-data (project-name root) "Interpret EPROJECT-EXTRA-ATTRIBUTES for PROJECT-NAME (in ROOT)." (loop for (key attributes) in eproject-extra-attributes append (cond ((functionp key) (if (funcall key root) attributes nil)) ((not (listp key)) (error "Bad eproject user data (%s %s), %s must be a list/function" key attributes key)) ((and (eq (cdr key) :project-name) (equal (car key) project-name)) attributes) ((and (eq (cdr key) :root-regexp) (string-match (car key) root)) attributes) (t nil)))) (defun eproject--interpret-metadata (data root) "Interpret DATA with respect to ROOT. This mostly means evaluating functions and passing everything else through unchanged." (loop for i in data collect (if (functionp i) (funcall i root) i))) (defun eproject--init-attributes (root type) "Update the EPROJECT-ATTRIBUTES-ALIST for the project rooted at ROOT (of TYPE)." (let ((project-data (assoc root eproject-attributes-alist))) (when (null project-data) (let* ((class-data (eproject--interpret-metadata (eproject--compute-all-applicable-metadata type) root)) ;; read the .eproject (or whatever) file (config-file (concat root (getf class-data :config-file ".eproject"))) (config-file-contents (with-temp-buffer (ignore-errors (insert-file-contents config-file nil nil nil t)) (buffer-substring-no-properties (point-min) (point-max)))) (config-file-sexp (read (format "(list %s)" config-file-contents))) (data-is-unsafe (unsafep config-file-sexp)) (config-file-data (cond (data-is-unsafe (warn "Config file %s contains unsafe data (%s), ignoring!" config-file data-is-unsafe) nil) (t (let ((data (eval config-file-sexp))) (if data (nconc (list :loaded-from-config-file config-file) data) nil))))) ;; combine class and config data; config overriding class (class-and-config-data (cond ;; ensure that the config-file-data is really a plist ((evenp (length config-file-data)) (nconc config-file-data class-data)) (t class-data))) ;; calculate the project name, as it's used by "user ;; data" ;; backcompat note: not sure why i looked in ;; :project-name for the value to set the :name attribute ;; to. so now we look in both, preferring the new way. (name (or (getf class-and-config-data :name) (getf class-and-config-data :project-name) (directory-file-name (elt (reverse (eshell-split-path root)) 0)))) ;; finally, merge in the "user data" (user-data (eproject--interpret-metadata (eproject--eval-user-data name root) root)) ;; now compute the final list of attributes (data (nconc user-data class-and-config-data))) (add-to-list 'eproject-attributes-alist (cons root (nconc (list :type type :name name) data))))))) (defvar eproject-mode-map (make-sparse-keymap) "Keybindings while in eproject-mode") (define-minor-mode eproject-mode "A minor mode for buffers that are a member of an eproject project." nil " Project" eproject-mode-map (when (null eproject-root) (error "Please do not use this directly. Call eproject-maybe-turn-on instead."))) (defun eproject-maybe-turn-on () "Turn on eproject for the current buffer, if it is in a project." (interactive) (let (bestroot besttype (set-before (mapcar #'car eproject-attributes-alist))) (loop for type in (eproject--all-types) do (let ((root (eproject--run-project-selector type))) (when (and root (or (not bestroot) ;; longest filename == best match (XXX: ;; need to canonicalize?) (> (length root) (length bestroot)))) (setq bestroot root) (setq besttype type)))) (when bestroot (setq eproject-root (file-name-as-directory bestroot)) ;; read .eproject file (etc.) and initialize at least :name and ;; :type (condition-case e (eproject--init-attributes eproject-root besttype) (error (display-warning 'warning (format "There was a problem setting up the eproject attributes for this project: %s" e)))) ;; with :name and :type set, it's now safe to turn on eproject (eproject-mode 1) ;; initialize buffer-local variables that the project defines ;; (called after we turn on eproject-mode, so we can call ;; eproject-* functions cleanly) (condition-case e (eproject--setup-local-variables) (error (display-warning 'warning (format "Problem initializing project-specific local-variables in %s: %s" (eproject--buffer-file-name) e)))) ;; run the first-buffer hooks if this is the first time we've ;; seen this particular project root. (when (not (member eproject-root set-before)) (run-hooks 'eproject-first-buffer-hook)) ;; run project-type hooks, which may also call into eproject-* ;; functions (run-hooks (intern (format "%s-project-file-visit-hook" besttype))) ;; return the project root; it's occasionally useful for the caller bestroot))) (defun eproject--setup-local-variables () "Setup local variables as specified by the project attribute :local-variables." (let* ((var-maker (eproject-attribute :local-variables)) (vars (cond ((functionp var-maker) (funcall var-maker (eproject-root) (file-relative-name (eproject--buffer-file-name) (eproject-root)))) ((listp var-maker) var-maker)))) (loop for (name val) on vars by #'cddr do (set (make-local-variable name) val)))) (defun eproject--search-directory-tree (directory file-regexp ignore-regexp) (loop for file in (directory-files (file-name-as-directory directory) t "^[^.]" t) when (and (not (file-directory-p file)) (not (string-match ignore-regexp file)) (not (string-match ignore-regexp (file-name-nondirectory file))) (string-match file-regexp file)) collect file into files when (file-directory-p file) collect file into directories finally return (nconc files (loop for dir in directories nconc (eproject--search-directory-tree dir file-regexp ignore-regexp))))) (defun eproject-assert-type (type) "Assert that the current buffer is in a project of type TYPE." (when (not (memq type (eproject--linearized-isa (eproject-type) t))) (error (format "%s is not in a project of type %s!" (current-buffer) type)))) (defun eproject--combine-regexps (regexp-list) "Combine regexps like `regexp-opt', but without quoting anything. Argument REGEXP-LIST is a list of regexps to combine." (format "\\(?:%s\\)" (reduce (lambda (a b) (concat a "\\|" b)) (mapcar (lambda (f) (format "\\(?:%s\\)" f)) regexp-list)))) (defun* eproject-list-project-files (&optional (root (eproject-root))) "Return a list of all project files in PROJECT-ROOT." (let ((matcher (eproject--combine-regexps (eproject-attribute :relevant-files root))) (ignore (eproject--combine-regexps (cons (concat (regexp-opt completion-ignored-extensions t) "$") (eproject-attribute :irrelevant-files root))))) (eproject--search-directory-tree root matcher ignore))) (defun* eproject-list-project-files-relative (&optional (root (eproject-root))) (mapcar (lambda (file) (file-relative-name file root)) (eproject-list-project-files root))) (define-derived-mode dot-eproject-mode emacs-lisp-mode "dot-eproject" "Major mode for editing .eproject files." (define-key dot-eproject-mode-map (kbd "C-c C-c") #'eproject-reinitialize-project)) ;; introspect sets of projects (defun eproject-projects () "Return a list of (name . root) pairs of all known eproject projects." (let ((hash (make-hash-table :test 'equal))) (loop for f in eproject-projects-hook do (loop for (name . root) in (funcall f) do (puthash name root hash))) (loop for (root . rest) in eproject-attributes-alist do (puthash (or (getf rest :name) (getf rest :project-name)) root hash)) (loop for name being each hash-key in hash collect (cons name (gethash name hash))))) (defun eproject-project-names () "Return a list of project names known to eproject." (mapcar #'car (eproject-projects))) ;; Finish up (defun eproject--after-change-major-mode-hook () (when (and (buffer-file-name) (not eproject-root)) (eproject-maybe-turn-on))) (defun eproject--after-save-hook () ;; TODO: perhaps check against relevant-files or irrelevant-files ;; regex? I'm avoiding this now because I'd rather not force the ;; speed hit -- if the user wants to do something slow after save, ;; fine... but I'd rather not make the decision for him. (when (and (boundp 'eproject-root) eproject-root) (run-hooks 'eproject-project-change-hook))) (add-hook 'find-file-hook #'eproject-maybe-turn-on) (add-hook 'dired-mode-hook #'eproject-maybe-turn-on) (add-hook 'after-change-major-mode-hook #'eproject--after-change-major-mode-hook) (add-hook 'after-save-hook #'eproject--after-save-hook) (add-hook 'eproject-project-change-hook #'eproject--maybe-reinitialize) (add-to-list 'auto-mode-alist '("\\.eproject$" . dot-eproject-mode)) (provide 'eproject) ;;; eproject.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/ff-paths.el0000775000000000000000000013106312230377265021304 0ustar ;;; ff-paths.el --- searches certain paths to find files. ;; Copyright (C) 1994-2005 Peter S. Galbraith ;; Author: Peter S. Galbraith ;; Created: 16 Sep 1994 ;; Version: 3.23 (Jul 08 2005) ;; Keywords: find-file, ffap, paths, search ;;; This file is not part of GNU Emacs. ;; This package 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 2, or (at your option) ;; any later version. ;; This package 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; see the file COPYING. ;; If not, write to the Free Software Foundation, 675 Mass Ave, ;; Cambridge, MA 02139, USA. ;; ---------------------------------------------------------------------------- ;;; Commentary: ;; New versions of this package (if they exist) may be found at: ;; http://people.debian.org/~psg/elisp/ff-paths.el ;; or in the Debian package `emacs-goodies-el'. ;; This code allows you to use C-x C-f normally most of the time, except that ;; if the requested file doesn't exist, it is checked against a list of ;; patterns for special paths to search for a file of the same name. ;; ;; Examples: ;; - a file extension of .bib will cause to search the path defined in ;; $BSTINPUTS or $BIBINPUTS for the file you requested. ;; - a file extension of .h will cause the /usr/include/ and ;; /usr/local/include/ directory trees to be searched. ;; - a file extension of .sty causes a search of TEXINPUTS and of all ;; directories below /usr/lib/texmf/tex/ ;; - a file extension of .el causes a search of the path set in the ;; emacs variable load-path. ;; - If the aboves searches don't return a match, the filename is searched ;; for using the `locate' command (if available on your system). ;; - gzip-compressed files (.gz) will also be found by ff-paths if ;; the package jka-compr is present. If you use some other package, ;; simply set the ff-paths-gzipped variable to t: ;; If one file is found, or many files of the same name are found, then the ;; *completions* buffer is displayed with all possibilities, including the ;; non-existing path you first provided. Selecting it creates the new ;; file. ;; ;; This package runs as a find-file-not-found-hooks hook, and so will ;; happily live alongside other such file-finding mechanisms (e.g. ;; PC-look-for-include-file PC-try-load-many-files vc-file-not-found-hook) ;; The patterns to test against filenames and the associated paths to search ;; for these files can be modified by the user by editing the variable ;; ff-paths-list defined below. ;; I suggest that you use ffap.el by Michelangelo Grigni , ;; now part of GNU Emacs. His package will guess the filename from the ;; text under the editing point. It will search for an existing file in ;; various places before you even get the "File: " prompt. ff-paths will ;; provide itself to ffap as an additional tool to locate the file before ;; you ever see a prompt. ff-paths behaves slightly differently with ffap ;; than it does with find-file: if the file path selected under point by ;; ffap does not exist, it is not shown in the completions buffer along ;; with existing paths. If only one existing path is found for said file, ;; it is placed in the minibuffer at the ffap prompt. Also, since using ;; the `locate' command is fairly aggressive, it is not used in the ffap ;; toolkit. ;;; Installation: ;; ;; ff-paths installs itself as a hook in find-file-not-found-hooks for ;; find-file. If ffap is installed, ff-paths installs itself as a toolbox ;; hook in ffap-alist (so load ff-paths after ffap). ;; ;; All you need to do is add this in ~/.emacs: ;; (require 'ff-paths) ;; (ff-paths-install) ;; or customize the variable `ff-paths-install' to enable it. ;; ;; NOTE: ff-paths used to install itself when it was loaded. It no longer ;; does so because that is against the Emacs coding conventions. ;; ;; ;; You may alter the value of the variables: ;; ;; ff-paths-list ;; ff-paths-use-locate ;; ff-paths-locate-max-matches ;; ff-paths-using-ms-windows ;; ff-paths-display-non-existent-filename ;; ff-paths-prompt-for-only-one-match ;; ff-paths-require-match ;; ff-paths-gzipped ;; ;; To see their documentation and current settings, do: ;; C-h v ff-paths-list ;; because that variable is _not_ customized, and also for all other ;; variables: ;; M-x customize-group ff-paths. ;; ---------------------------------------------------------------------------- ;;; Change log: ;; ;; V1.01 16sep94 - created by Peter S. Galbraith, ;; rhogee@bathybius.meteo.mcgill.ca ;; V1.02 20sep94 - by Peter S. Galbraith ;; Change TeX-split-string to dired-split (thanks to Michelangelo Grigni) ;; Change variable name psg-ff-list to ff-paths-list ;; Added find-file-noselect-using-paths for ffap.el ;; Added ff-paths-prompt variable ;; V1.03 12oct94 - by Peter S. Galbraith ;; Fixed: ;; - error when nil appeared in ff-paths-list translation ;; (meaning current default) ;; - find-file-at-point would switch buffer if new file were not created. ;; V1.04 24oct94 - by Peter S. Galbraith ;; Added patch from Ziv Gigus to let environment variables ;; have trailing directory paths: ;; ("^foo_.*\\.[ch]$" "$FOO1:$FOO/bar:$FOO/barnone") ;; V2.00 05Jul95 - by Peter S. Galbraith ;; Reworked interface ;; Tremendous thanks to Bill Brodie for telling me how ;; to make completing-read start off with the completions buffer displayed. ;; It made this version possible without a kludge. Thanks Bill! ;; V2.01 05Jul95 - by Peter S. Galbraith ;; - Followed Bill Brodie's suggestions to make ff-paths-list not ;; necessarilly a colon-separated string, but rather usually a list ;; of strings: ("\\.bib$" "$BSTINPUTS:$BIBINPUTS") ;; -> ("\\.bib$" "$BSTINPUTS" "$BIBINPUTS") ;; - Also his suggestion to not quote symbols. ;; - Also his suggestion to include leftmost matches as initial string ;; to completing-read. ;; - Also, I substitute ~/ for the home directory if possible in the ;; matches displayed in the completions buffer. ;; V2.02 Jul 19 95 - Peter Galbraith ;; - Had introduced bug in search-directory-tree. synced with bib-cite.el. ;; V3.00 Jul 26 95 - Peter Galbraith ;; - Now a hook to find-file and ffap. Removed `create buffer?' prompt. ;; V3.01 Sep 13 95 ;; - dired-aux may not be loaded - Yoichi Konno ;; - added ff-paths-display-non-existent-filename ;; Jason Hatch ;; - psg-translate-ff-list was reversing directory order ;; Juergen Vollmer ;; V3.02 March 20 96 ;; dired-aux not in XEmacs - Vladimir Alexiev ;; V3.03 August 19 96 ;; ff-paths-prompt-for-only-one-match added. ;; Havard Fosseng ;; V3.04 August 26 96 Sudish Joseph (RCS 1.4) ;; - Use unread-command-events instead of unread-command-char. ;; V3.05 December 31 96 - Christoph Wedler ; (RCS 1.5) ;; - Use minibuffer-setup-hook instead of unread-command-events. ;; - Better minibuffer-quit. ;; - New variable `ff-paths-prompt' ;; - New variable `ff-paths-require-match' ;; - Changed from `dired-split' to copying AUCTeX's code. ;; V3.06 Janury 18 97 (RCS 1.6) ;; - Added the `locate' command functionality. ;; V3.07 July 16 97 (RCS 1.8) ;; - Added gzipped files ;; - Fixed infinite loop in recursive search with directory soft links ;; such as: /usr/include/ncurses -> . ;; V3.08 December 15 97 ;; - Hacked simpler create-alist-from-list (RCS 1.9) ;; - Handle file that exists but are not readable (RCS 1.10) ;; V3.09 December 17 97 (RCS 1.11) ;; - Added special face to completion buffer for non-existent filename. ;; V3.10 December 18 97 (RCS 1.13) ;; - Made V3.09 change work in XEmacs also. ;; V3.11 August 08 1998 (RCS 1.15) ;; - Compatible with GNU/Emacs compiled on NT/Win95 ;; V3.12 September 28 1998 (RCS 1.16) ;; - ff-paths-list can contain many entries for a filename match. ;; - ffap calls ff-paths on any filename (so users can modify ff-paths-list). ;; - ff-paths-locate validates filenames in case they have since been deleted ;; V3.13 November 12 1998 (RCS 1.17) ;; - Added ff-paths-use-locate equals 1 for high priority use. ;; - self-detection of locate for ntemacs. ;; V3.14 December 29 1999 (RCS 1.18) ;; - switch to GPL. ;; - psg-convert-homedir-to-tilde uses files.el's abbreviate-file-name ;; V3.15 October 02 2000 (RCS 1.19) ;; - spelling error: changed existant -> existent everywhere, affecting ;; user variables. Sorry. ;; V3.16 January 08 2001 (RCS 1.20) ;; - Added ff-paths-locate-max-matches, defaults to 20 matches. ;; V3.17 January 17 2001 (RCS 1.22) ;; - Oops! defvar ff-paths-locate-max-matches. ;; V3.18 January 07 2002 (RCS 1.24) Michael Ernst ;; Quote filenames before passing them to locate. Without this change, ;; ff-paths may return many irrelevant matches. More seriously, the ;; locate command may take a very long time to complete, if some portion ;; of the the filename matches many files. (I was given a file named ;; "procedure - version 1", and locate went to town on the "-".) ;; V3.19 April 21st 2003 PSG ;; - checkdoc cleaning. ;; - customization (still lacking the main variable `ff-paths-list'!) ;; - byte-compiles clean! ;; V3.20 June 16 2003 PSG ;; - Add /usr/X11R6/include// to ff-paths-list ;; - Add ff-paths-install to install this package (instead of doing so ;; automatically at load time). ;; - Add ff-paths-install defcustom to enable package. ;; V3.21 Aug 14 2003 PSG ;; - ff-paths-list-env: code cleanup. ;; V3.22 Nov 21 2003 PSG ;; - Add defcustoms `ff-paths-locate-ignore-filenames-default', ;; `ff-paths-locate-ignore-filenames' and `ff-paths-locate-ignore-regexps' ;; and support infracstructure to skip using locate for certain ;; (common) filenames. ;; V3.23 Jul 08 2005 Heath Morgan ;; - Reinsert `ff-paths-prompt-for-only-one-match' in XEmacs code. ;; ---------------------------------------------------------------------------- ;;; Code: (eval-when-compile (require 'cl)) (defgroup ff-paths nil "Find file using paths." :group 'ffap :group 'matching :group 'convenience) ;; The following variable may be edited to suit your site: ;; Send me your interesting add-ons too! (defvar ff-paths-list '(("\\.awk$" "$AWKPATH") ; awk files in AWKPATH env variable. ("\\.bib$" "$BSTINPUTS" "$BIBINPUTS") ; bibtex files. ("\\.\\(sty\\|cls\\)$" "$TEXINPUTS" "/usr/share/texmf/tex//") ;LaTeX files ("\\.[h]+$" "/usr/local/include//" "/usr/include//" "/usr/X11R6/include//") ("^\\." "~/") ; .* (dot) files in user's home ("\\.el$" load-path)) ; el extension in load-path elisp var "*List of paths to search for given file extension regexp's. The directories can be: - colon-separated directories and ENVIRONMENT variables (which may also translate to colon-separated directories) - list of strings representing directories or environment variables. - a symbol object evaluating to a list of strings (e.g. `load-path') You may mix environment variables and directory paths together. You may add trailing directory paths to environment variables, e.g. $HOME/bin You may not mix strings with elisp lists (like `load-path'). You may terminate a directory name with double slashes // indicating that all subdirectories beneath it should also be searched.") ;; Other variables (defvar ff-paths-prompt "Find File: " "Prompt used by ff-paths.") (defvar ff-paths-have-reached-locate-max nil "Internal to ff-paths to remember if max count is reached on this search.") (defvar ff-paths-in-ffap-name "" "Filename used when `ff-paths-in-ffap' called. Find-file-using-paths-hook does nothing if called with this same name to avoid searching twice for a non-existing file the user actually wants to create") (defvar ff-paths-non-existent-filename nil "Internal holder for a filename that doesn't exist on the filesystem.") ;; ---------------------------------------------------------------------------- ;;; Installs itself as hooks at the end of the file ;; (so it won't if error in byte-compiling) ;; ---------------------------------------------------------------------------- ;; Notes about ffap ;; ;; This defines two hooks: ;; - ff-paths-in-ffap used by ffap if it found a filename around point ;; which doesn't exist in the specified path or default directory. ;; - find-file-using-paths-hook used by find-file when the specific file ;; path does not exist. ;; ;; If ffap doesn't find a filename around point and prompts the user for a ;; filename and that file doesn't exist, ffap will not use its bag of ;; tricks to find the file (which would include ff-paths-in-ffap), but ;; will rather pass the filename directly to find-file, which will call ;; find-file-using-paths-hook. So both hooks are actually used. This is ;; ok, but I'll have to change things if ffap changes this behaviour. ;; ;; If ffap finds a filename around point but said file does not exit, ffap ;; will use ff-paths-in-ffap (as part of its toolbox) to locate the file. ;; I do not include the non-existent file as a possible completion because ;; ffap cannot readily deal with this. If only one file is found it is ;; returned to ffap, which will prompt the user using it as an initial ;; string. If no files are found, ff-paths-in-ffap recurses through ;; directory paths ending in // to try again. If two or more files are ;; found, ff-paths-in-ffap will use the completions buffer to ask which ;; the user wants, and returns it to ffap. Unfortunately, ffap doesn't ;; know any better than to prompt the user again with this filename. ;; If ffap and ff-paths-in-ffap both fail, ffap will pass the argument to ;; vanilla find-file and find-file-using-paths-hook will be called down ;; the line because the file does not exist. find-file-using-paths-hook ;; checks if called with same filename (which will also be same as ;; ffap-string-at-point) and doesn't do anything if it is. This handles ;; the case where the user actually wanted to create this new file. ;; ff-paths-in-ffap can't let the user edit completions to some ;; non-existing file because ffap will check for existence, crush the ;; choice and display a fresh prompt. (defvar ff-paths-is-XEmacs (not (null (save-match-data (string-match "XEmacs\\|Lucid" emacs-version))))) ;;FIXME: Should use defface if using Emacs-20 (defvar ff-paths-non-existent-file-face 'ff-paths-non-existent-file-face "Face to use for message marked for deletion in mh-e folder-mode.") (make-face 'ff-paths-non-existent-file-face) (if ff-paths-is-XEmacs (make-face-bold 'ff-paths-non-existent-file-face nil) (make-face-bold 'ff-paths-non-existent-file-face nil t)) (set-face-foreground 'ff-paths-non-existent-file-face "NavyBlue" nil) (defvar buf) (defvar truename) (defvar number) (defvar filename) (defvar ff-paths-use-locate) (defvar ff-paths-display-non-existent-filename) (defvar ff-paths-require-match) (defvar ff-paths-locate-max-matches) (defvar ff-paths-gzipped) (defvar ff-paths-using-ms-windows) (defvar ff-paths-locate-ignore-filenames-compiled) (defvar ff-paths-locate-ignore-filenames-default) (defvar ff-paths-locate-ignore-filenames) (defvar ff-paths-locate-ignore-regexps) (defun find-file-using-paths-hook () "Search for file not found in path specified by the variable `ff-paths-list'." ;; This is called by find-file after it fails. ;; find-file can itself be called by ffap if no string was under point. (if (or (ff-paths-file-exists-but-cannot-be-read buffer-file-name) (string-equal buffer-file-name ff-paths-in-ffap-name)) nil (let* ((the-name (file-name-nondirectory buffer-file-name)) (matches (or (if (and (equal ff-paths-use-locate '1) (ff-paths-locate-filename-p the-name)) (ff-paths-locate the-name)) (psg-filename-in-directory-list the-name (ff-paths-from-list the-name)) (if (and (equal ff-paths-use-locate 't) (ff-paths-locate-filename-p the-name)) (ff-paths-locate the-name)))) (bufname (buffer-name buf)) ; compute before uniquify hits! newbuf) (if (null matches) nil ;Return nil (if (not ff-paths-display-non-existent-filename) (setq matches (psg-convert-homedir-to-tilde matches)) (setq matches (psg-convert-homedir-to-tilde (cons (expand-file-name buffer-file-name) matches))) (setq ff-paths-non-existent-filename (car (psg-convert-homedir-to-tilde (list buffer-file-name))))) ;;From: Christoph Wedler ;; * The code of automatically displaying the *Completion* Buffer doesn't work ;; in XEmacs 19.13 (this is fixed in the patch below, ffap did something ;; similar--but I prefer `cons'ing to `minibuffer-setup-hook' instead of ;; setting this hook) ;; Replace this: ;; (let ((unread-command-char ??)) ;; (setq the-name ;; (if (and (not ff-paths-prompt-for-only-one-match) ;; (null (cdr matches))) ;; (car matches) ;; (or (and (string-equal "18" (substring emacs-version 0 2)) ;; (completing-read "Find file: " ;; (create-alist-from-list matches) ;; nil nil ;; (psg-common-in-list matches))) ;; (completing-read "Find file: " ;; (create-alist-from-list matches) ;; nil nil ;; (psg-common-in-list matches) ;; 'file-name-history))))) ;; ;; With this: (condition-case nil (let ((minibuffer-setup-hook (cons 'minibuffer-completion-help minibuffer-setup-hook)) (completion-setup-hook (append (symbol-value 'completion-setup-hook) (list 'ff-paths-fontify-non-existent-filename 'ff-paths-display-locate-max-reached)))) (setq the-name ;; Heath Morgan pointed out that ;; `ff-paths-prompt-for-only-one-match' had been dropped. ;; Added back in V3.23 (if (and (not ff-paths-prompt-for-only-one-match) (null (cdr matches))) (car matches) (or (and (string-equal "18" (substring emacs-version 0 2)) (completing-read ff-paths-prompt (create-alist-from-list matches) nil ff-paths-require-match (psg-common-in-list matches))) (completing-read ff-paths-prompt (create-alist-from-list matches) nil ff-paths-require-match (psg-common-in-list matches) 'file-name-history))))) (quit (setq the-name nil))) ;; End of Christoph Wedler's change. (if (or (not the-name) (string-equal "" the-name) (not (file-exists-p the-name))) nil ;Return nil (let ((find-file-hooks)) ;Don't call hooks twice ; (funcall 'find-file (expand-file-name the-name)))))))) (setq newbuf (set-buffer (find-file-noselect the-name)))) (kill-buffer buf) (rename-buffer bufname) ;; Side-effect variables of parent find-file-noselect (setq buf newbuf filename buffer-file-name truename buffer-file-truename number buffer-file-number) t))))) (defun ff-paths-fontify-non-existent-filename () "Fontify the non-existing filename in *Completions* if using `window-system'." (cond ((and window-system ff-paths-display-non-existent-filename (boundp 'ff-paths-non-existent-filename) ff-paths-non-existent-filename) (save-excursion (set-buffer standard-output) (goto-char (point-min)) (if (search-forward ff-paths-non-existent-filename nil t) (progn (put-text-property (match-beginning 0) (match-end 0) 'face 'ff-paths-non-existent-file-face) (goto-char (point-min)) (if (search-forward "Possible completions are:" nil t) (forward-line -1)) (let ((the-start (point)) (buffer-read-only nil)) (insert "The filename in this face is the path you requested and does not exist.\n") (put-text-property the-start (point) 'face 'ff-paths-non-existent-file-face)))))))) (defun ff-paths-display-locate-max-reached () "Add a line in completions buffer to say that locate maximum is reached." (if ff-paths-have-reached-locate-max (save-excursion (set-buffer standard-output) (goto-char (point-min)) (if (search-forward "Possible completions are:" nil t) (forward-line -1)) (let ((buffer-read-only nil)) (insert "Only the first " (int-to-string ff-paths-locate-max-matches) " matches are listed.\n")))) (setq ff-paths-have-reached-locate-max nil)) (defun ff-paths-file-exists-but-cannot-be-read (file-name) "Return t if FILE-NAME exists but cannot be Read. `find-file' calls `find-file-not-found-hooks' when this is the case, but I don't think it should. ff-paths should deal with it anyway..." (and (file-exists-p file-name) (not (file-readable-p file-name)))) (defun ff-paths-in-ffap (name) "Search for NAME in path specified in `ff-paths-list'." ;; This is called by ffap before it prompts. (setq ff-paths-in-ffap-name (expand-file-name name)) (let* ((the-name (file-name-nondirectory name)) (matches (psg-filename-in-directory-list the-name (ff-paths-from-list the-name)))) (cond ((null matches) ; No match, Return nil nil) ((null (cdr matches)) ; Single matche (car matches)) (t (setq matches (psg-convert-homedir-to-tilde matches)) (condition-case nil (let ((minibuffer-setup-hook (cons 'minibuffer-completion-help minibuffer-setup-hook))) (setq the-name (or (and (string-equal "18" (substring emacs-version 0 2)) (completing-read ff-paths-prompt (create-alist-from-list matches) nil t (psg-common-in-list matches))) (completing-read ff-paths-prompt (create-alist-from-list matches) nil t (psg-common-in-list matches) 'file-name-history)))) (quit (setq the-name nil))) (if (and the-name (not (string-equal "" the-name))) the-name nil))))) (defvar ffap-alist) ;;(defun ff-paths-in-ffap-install () ;; "Install ff-paths in ffap toolbox to find files from name under point" ;; (cond ;; ((and (boundp 'ffap-alist) ;; (not (member ;; (cons "\\(^\\.\\)\\|\\.\\(awk\\|bib\\|sty\\|cls\\|[h]+\\|el\\)$" ;; 'ff-paths-in-ffap) ;; ffap-alist))) ;; (setq ffap-alist ;; (nconc ;; ffap-alist ;; (list ;; (cons "\\(^\\.\\)\\|\\.\\(awk\\|bib\\|sty\\|cls\\|[h]+\\|el\\)$" ;; 'ff-paths-in-ffap))))))) ;; FIXME: Either make ffap call ff-paths on any file like here, or build a ;; regexp from ff-paths-list (defun ff-paths-in-ffap-install () "Install ff-paths in ffap toolbox to find files from name under point." (cond ((and (boundp 'ffap-alist) (not (member '("." . ff-paths-in-ffap) ffap-alist))) (setq ffap-alist (append ffap-alist '(("." . ff-paths-in-ffap))))))) ;; There must be a command to do this! (defun psg-common-in-list (list) "Return STRING with same beginnings in all strings in LIST." (let* ((first-string (car list)) (work-list (cdr list)) (match-len (length first-string))) (while work-list (let ((i 1)) (while (and (<= i match-len) (<= i (length (car work-list))) (string-equal (substring first-string 0 i) (substring (car work-list) 0 i)) (setq i (1+ i)))) (setq match-len (1- i))) (setq work-list (cdr work-list))) (substring first-string 0 match-len))) (defun psg-convert-homedir-to-tilde (list) "Shorten LIST elements by substituting teh home directory by tilde." (let* ((work-list list)(result-list) (homedir (concat "^" (file-name-as-directory (expand-file-name "~")))) (the-length (1- (length homedir)))) (while work-list (if (fboundp 'abbreviate-file-name) (setq result-list (cons (abbreviate-file-name (car work-list)) result-list)) (if (string-match homedir (car work-list)) (setq result-list (cons (concat "~/" (substring (car work-list) the-length)) result-list)) (setq result-list (cons (car work-list) result-list)))) (setq work-list (cdr work-list))) (nreverse result-list))) ;; Defined in bib-cite.el ! (defun create-alist-from-list (the-list) (mapcar 'list the-list)) (defun psg-filename-in-directory-list (filename list) "Check for presence of FILENAME in directory LIST. Return all found. If none found, recurse through directory tree of directories ending in // and return all matches." ;;USAGE: (psg-filename-in-directory-list "emacs" (ff-paths-list-env "PATH")) ;;USAGE: (psg-filename-in-directory-list "ff-paths.el" load-path) ;;USAGE: (psg-filename-in-directory-list "ff-paths.el" (ff-paths-from-list "ff-paths.el")) (let ((the-list list) (filespec-list)) (while the-list (let* ((directory (or (and (not (car the-list)) ; list item is nil -> ~/ "~/") (substring (car the-list) 0 (string-match "//$" (car the-list))))) ;; This removed trailing // if any (filespec (expand-file-name filename directory))) (if (file-exists-p filespec) (setq filespec-list (cons filespec filespec-list))) (if (and ff-paths-gzipped (file-exists-p (concat filespec ".gz"))) (setq filespec-list (cons (concat filespec ".gz") filespec-list)))) (setq the-list (cdr the-list))) (if filespec-list filespec-list ;; If I have not found a file yet, then check if some directories ;; ended in // and recurse through them. (let ((the-list list)) (while the-list (if (or (not (car the-list)) ; `nil' case (not (string-match "//$" (car the-list)))) nil (setq filespec-list (append filespec-list (search-directory-tree (substring (car the-list) 0 (match-beginning 0)) (if ff-paths-gzipped (concat "^" filename "\\(.gz\\)?$") (concat "^" filename "$")) t nil)))) (setq the-list (cdr the-list)))) filespec-list))) ;;; search-directory-tree is heavily based on TeX-search-files ;; which recursively searches a list of directories for files ;; matching a list of extensions. This simplified version should ;; be a wee bit faster and will suit my purposes (for bib-cite's ;; need to search directories listed in BIBINPUTS recursively ;; if they end in //). ;; TeX-search-files is part of auc-tex: ;; Maintainer: Per Abrahamsen ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. ;; Copyright (C) 1987 Lars Peter Fischer ;; Copyright (C) 1991 Kresten Krab Thorup ;; Copyright (C) 1993, 1994 Per Abrahamsen ;; Also defined in bib-cite.el ! (defun search-directory-tree (directories extension-regexp recurse first-file) "Return recursive list of files in DIRECTORIES ending with EXTENSION-REGEXP. DIRECTORIES is a list or a single-directory string EXTENSION-REGEXP is actually (any) regexp, usually \\\\.bib$ If RECURSE is t, then we will recurse into the directory tree, nil, we will only search the list given. If FIRST-FILE is t, stop after first file is found." (or (listp directories) (setq directories (list directories))) (let ((match) (directories-done)) (while directories (let* ((directory (file-name-as-directory (car directories))) (content (and directory (file-readable-p directory) (ff-paths-file-directory-p directory) (directory-files directory)))) (setq directories (cdr directories)) (setq directories-done (cons directory directories-done)) (while content (let ((file (expand-file-name (car content) directory))) (cond ((string-match "[.]+$" (car content))) ;This or parent dir ((not (file-readable-p file))) ((and recurse (ff-paths-file-directory-p file)) (if (not (member (file-name-as-directory (file-chase-links file)) directories-done)) (setq directories (cons (file-name-as-directory (file-chase-links file)) directories)))) ((string-match extension-regexp (file-name-nondirectory file)) (and first-file (setq content nil directories nil)) (setq match (cons file match))))) (setq content (cdr content))))) match)) (defun ff-paths-split-path (string) "Split a path STRING such as \"/some/directory:/some/other\". The returned list is like (\"/some/directory\" \"/some/other\"." (let ((splitter (or (and ff-paths-using-ms-windows ";") ":"))) (ff-paths-split-string splitter string))) ;; copied from auctex's TeX-split-string (defun ff-paths-split-string (regexp string) "Return a list of strings given a REGEXP and a STRING. The string is split into sections which were seperated by REGEXP. Examples: (ff-paths-split-string \"\:\" \"abc:def:ghi\") -> (\"abc\" \"def\" \"ghi\") (ff-paths-split-string \" *\" \"dvips -Plw -p3 -c4 testfile.dvi\") -> (\"dvips\" \"-Plw\" \"-p3\" \"-c4\" \"testfile.dvi\") If REGEXP is nil, or \"\", an error will occur." (let ((start 0) (result '())) (while (string-match regexp string start) (let ((match (string-match regexp string start))) (setq result (cons (substring string start match) result)) (setq start (match-end 0)))) (setq result (cons (substring string start nil) result)) (nreverse result))) ;; `ff-paths-from-list' and `ff-paths-expand-path' together replace ;; the old `psg-translate-ff-list' (defun ff-paths-from-list (filename) "Given a FILENAME, return corresponding directory list from `ff-paths-list'. Return nil if file name extension is not listed in `ff-paths-list'. So translate the cdr of the `ff-paths-list' entry to a directory list. NOTE: returned nil means no match, but nil as an element of the returned list is valid, meaning current-directory!" (let ((local-ff-list ff-paths-list)(the-path)) (while local-ff-list (let ((the-pair (car local-ff-list))) (cond ((string-match (car the-pair) filename) (setq the-path (append the-path (ff-paths-expand-path (cdr the-pair)))))) (setq local-ff-list (cdr local-ff-list)))) the-path)) (defun ff-paths-expand-path (unexpanded-path) "UNEXPANDED-PATH is expanded. It should hold a list of: no match -> nil symbol -> (load-path) stringed PATH -> (\"/usr/local/include//:/usr/include//\") many such strings -> (\"/usr/local/include//\" \"/usr/include//\") appended env var -> (\"$FOO/bar\")" (cond ((not unexpanded-path) ; nil case, and we're done. nil) ((symbolp (car unexpanded-path)) ; load-path type symbol (eval (car unexpanded-path))) ; ->Return it, and we're done. (t ;string case, expand each element (let ((the-list)) (while unexpanded-path (let ((the-elements (ff-paths-split-path (car unexpanded-path))) (path-list) (element)) (while the-elements (setq element (car the-elements)) (setq the-elements (cdr the-elements)) (if (string-match "^\\$" element) ; an ENVIRONMENT var? (setq path-list (nconc path-list (ff-paths-list-env (substring element 1)))) (if (ff-paths-file-directory-p element) ; Add only if it exists (setq path-list (cons element path-list))))) (if path-list (setq the-list (append the-list path-list)))) (setq unexpanded-path (cdr unexpanded-path))) the-list)))) (defun ff-paths-list-env (env) "Return a list of directory elements in ENV variable (w/o leading $) argument may consist of environment variable plus a trailing directory, e.g. HOME or HOME/bin" (let* ((slash-pos (string-match "/" env)) (value (if (not slash-pos) (getenv env) (concat (getenv (substring env 0 slash-pos)) (substring env slash-pos)))) (entries (and value (ff-paths-split-path value)))) (loop for x in entries if (ff-paths-file-directory-p x) collect x))) (defun ff-paths-file-directory-p (file) "Like default `file-directory-p' but allow FILE to end in // for ms-windows." (save-match-data (if (string-match "\\(.*\\)//$" file) (file-directory-p (match-string 1 file)) (file-directory-p file)))) ;;; `locate' stuff (defun ff-paths-locate (filename) "Try finding FILENAME using the locate command. Return a string if a single match, or a list if many matches." (let ((ff-buffer (get-buffer-create "*ff-paths-locate*")) status matches (count 0)) (save-excursion (set-buffer ff-buffer) (setq status (call-process "sh" nil t nil "-c" (concat "locate " (shell-quote-argument filename)))) (goto-char 1) (if (eq status 1) nil ;Not found... (while (and (or (not (boundp 'ff-paths-locate-max-matches)) (not ff-paths-locate-max-matches) (> ff-paths-locate-max-matches count)) (re-search-forward (if (and (boundp 'ff-paths-gzipped) ff-paths-gzipped) (concat "/" filename "\\(.gz\\)?$") (concat "/" filename "$")) nil t)) (let ((the-file (buffer-substring (progn (beginning-of-line)(point)) (progn (end-of-line)(point))))) (setq count (1+ count)) (if (and (file-exists-p the-file) (not (file-directory-p the-file))) (setq matches (cond ((not matches) (list the-file)) (t (cons the-file matches)))))))) (if (and (boundp 'ff-paths-locate-max-matches) ff-paths-locate-max-matches (<= ff-paths-locate-max-matches count)) (setq ff-paths-have-reached-locate-max t)) (kill-buffer ff-buffer) matches))) (defun ff-paths-locate-filename-p (filename) "Return t if ff-paths should try to find FILENAME using locate command. Checks FILENAME against `ff-paths-locate-ignore-filenames', `ff-paths-locate-ignore-filenames-default' and `ff-paths-locate-ignore-regexps'." (cond ((string-match ff-paths-locate-ignore-filenames-compiled filename) nil) (t (not (car (memq t (mapcar (lambda (x) (not (null (string-match x filename)))) ff-paths-locate-ignore-regexps))))))) (defun ff-paths-have-locate () "Determine if the `locate' command exists on this system." (if (not (condition-case nil (not (call-process "sh" nil 0 nil)) (error))) nil ;No `sh' command on system (cond ((and (fboundp 'executable-find) (executable-find "locate")) t) ((ff-paths-locate "bin/locate") t) ((ff-paths-locate "locate.exe") t) (t nil)))) ;;;###autoload (defun ff-paths-install () "Install ff-paths as a `find-file-not-found-hooks' and to ffap package." (add-hook 'find-file-not-found-hooks 'find-file-using-paths-hook t) (ff-paths-in-ffap-install)) (defcustom ff-paths-install nil "Whether to setup ff-paths for use. find-file-using-paths searches certain paths to find files." :type 'boolean :set (lambda (symbol value) (set-default symbol value) (when value (ff-paths-install))) :require 'ff-paths :group 'ff-paths) (defcustom ff-paths-use-ffap nil "Whether to setup ffap and its key bindings for use. Usually packages don't advertise or try to setup other packages, but ff-paths works well in combination with ffap (Find FILENAME, guessing a default from text around point) and so I recommend it here. find-file-using-paths searches certain paths to find files." :type 'boolean :set (lambda (symbol value) (set-default symbol value) (when value (require 'ffap) (ffap-bindings) (ff-paths-in-ffap-install))) :require 'ff-paths :group 'ff-paths) (defcustom ff-paths-use-locate (ff-paths-have-locate) "*Determines whether the `locate' command is used by ff-paths. If nil don't use it. If t use it but only if other ff-paths methods have failed. If 1 use it before any other mechanism (because it's faster). To set it to 1, add this to your ~/.emacs file: (setq ff-paths-use-locate '1) By default, this is set to t if it can be determined that your system has the locate command. Using locate is fairly aggressive, and so is *not* added to the ffap toolkit." :group 'ff-paths :type 'boolean) (defcustom ff-paths-display-non-existent-filename t "*find-file-using-paths-hook displays the prompted-for non-existent filename. If you use \"C-x C-f article.sty\" in a path where it does not exists, find-file-using-paths-hook will presumably find it for you. If this variable is set, then this non-existent filename will be displayed in the completions buffer along with the existing found file. This makes it more intuitive in case you really wanted to create the new file (instead of pressing C-g to create the new file)." :group 'ff-paths :type 'boolean) (defcustom ff-paths-prompt-for-only-one-match t "*If non-nil, prompt the user for filename even if there is only one match. If nil and `ff-paths-display-non-existent-filename' is also nil, then dispense with confirmation prompt when a single match is found for a non-existent file and edit that single matched file immediately." :group 'ff-paths :type 'boolean) (defvar ff-paths-locate-ignore-filenames-compiled nil "*Regexp matching files not searched for using locate. Do not alter this variable directly. Instead, customize `ff-paths-locate-ignore-filenames-default' checking off filenames normally not searched that you would like searched, and add extra filenames to not search for in `ff-paths-locate-ignore-filenames'.") (defun ff-paths-locate-ignore-filenames-compile () "Make or remake the variable `ff-paths-locate-ignore-filenames-compiled'. Done using `ff-paths-locate-ignore-filenames' and `ff-paths-locate-ignore-filenames-default' as input." (let ((list (cond ((and (boundp 'ff-paths-locate-ignore-filenames) ff-paths-locate-ignore-filenames (boundp 'ff-paths-locate-ignore-filenames-default) ff-paths-locate-ignore-filenames-default) (append ff-paths-locate-ignore-filenames ff-paths-locate-ignore-filenames-default)) ((and (boundp 'ff-paths-locate-ignore-filenames) ff-paths-locate-ignore-filenames) ff-paths-locate-ignore-filenames) ((and (boundp 'ff-paths-locate-ignore-filenames-default) ff-paths-locate-ignore-filenames-default) ff-paths-locate-ignore-filenames-default)))) (if list (setq ff-paths-locate-ignore-filenames-compiled (concat "^" ;; workaround for insufficient default (let ((max-specpdl-size 1000)) (regexp-opt list t)) "$")) (setq ff-paths-locate-ignore-filenames-compiled nil)))) (defcustom ff-paths-locate-ignore-filenames-default '("ChangeLog" "changelog" "changelog.gz" "changelog.Debian.gz" "copyright" "README" "README.Debian" "README.Debian.gz") "A customizable list of filenames to not search for using locate. Usually a list of very common filenames. See also `ff-paths-locate-ignore-filenames' and `ff-paths-locate-ignore-regexps'" :type '(set (const "ChangeLog") (const "changelog") (const "changelog.gz") (const "changelog.Debian.gz") (const "copyright") (const "README") (const "README.Debian") (const "README.Debian.gz")) :set (lambda (symbol value) (set-default symbol value) (ff-paths-locate-ignore-filenames-compile)) :group 'ff-paths) (defcustom ff-paths-locate-ignore-filenames nil "*Additional filenames to not search for using locate. Filenames that you would like the locate search to skip that aren't listed in `ff-paths-locate-ignore-filenames-default' can be added to this option with the caveat that regular expressions are not allowed. See also `ff-paths-locate-ignore-regexps'" :type '(repeat (string :tag "Filename:")) :set (lambda (symbol value) (set-default symbol value) (ff-paths-locate-ignore-filenames-compile)) :group 'ff-paths) (defcustom ff-paths-locate-ignore-regexps nil "*Additional regexps matching filenames to not search for using locate. Add regular expressions matching filenames that are not to be searched suing the system locate command here (because the names are too common to be useful). See also `ff-paths-locate-ignore-filenames-default' and `ff-paths-locate-ignore-filenames'." :type '(repeat (regexp :tag "Regular expression:")) :group 'ff-paths) (defcustom ff-paths-require-match nil "*Whether user has to choose one of the listed files. This is the argument REQUIRE-MATCH of `completing-read'." :group 'ff-paths :type 'boolean) (defcustom ff-paths-gzipped (featurep 'jka-compr) "*Search for gzipped-compressed file as well." :group 'ff-paths :type 'boolean) (defcustom ff-paths-using-ms-windows (and (boundp 'system-type) (equal system-type 'windows-nt)) "*Set to t if using DOS, win95, winNT, etc. The effect is to set path splitting on the \";\" character instead of \":\"" :group 'ff-paths :type 'boolean) (defcustom ff-paths-locate-max-matches 20 "*Maximum number of matches to extract from locate command. Only this number of mtaches will be displayed and all next matches will be ignored. If set to nil, any number of matches will be processed but be warned that this can take some time (for example, I have 939 files called changelog.Debian.gz on my system)" :group 'ff-paths :type 'integer) (provide 'ff-paths) ;;; ff-paths.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/pp-c-l.el0000775000000000000000000002567712230377265020701 0ustar ;;; pp-c-l.el --- Display Control-l characters in a pretty way ;; ;; Filename: pp-c-l.el ;; Description: Display Control-l characters in a buffer in a pretty way ;; Author: Drew Adams ;; Maintainer: Drew Adams ;; Copyright (C) 2007-2010, Drew Adams, all rights reserved. ;; Created: Thu Feb 08 20:28:09 2007 ;; Version: 1.0 ;; Last-Updated: Wed Apr 28 14:32:49 2010 (-0700) ;; By: dradams ;; Update #: 196 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/pp-c-l.el ;; Keywords: display, convenience, faces ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x ;; ;; Features that might be required by this library: ;; ;; None ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: ;; ;; Faces defined here: ;; ;; `pp^L-highlight'. ;; ;; User options defined here: ;; ;; `pp^L-^L-string', `pp^L-^L-string-function', ;; `pp^L-^L-string-post', `pp^L-^L-string-pre', ;; `pretty-control-l-mode'. ;; ;; Commands defined here: ;; ;; `pp^l', `pretty-control-l-mode', `refresh-pretty-control-l'. ;; ;; Non-interactive functions defined here: ;; ;; `pp^L-^L-display-table-entry', `pp^L-make-glyph-code'. ;; ;; ;; To use this library, add this to your initialization file ;; (~/.emacs or ~/_emacs): ;; ;; (require 'pp-c-l) ; Load this library. ;; ;; To turn on this mode by default, then either customize option ;; `pretty-control-l-mode' to non-nil or add this line also to your ;; init file: ;; ;; (pretty-control-l-mode 1) ; Turn on pretty display of `^L'. ;; ;; For most of the user options defined here, if you change the value ;; then you will need to re-enter `pretty-control-l-mode', for the ;; new value to take effect. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Change log: ;; ;; 2010/04/28 dadams ;; Added autoload cookie for pp^L-^L-display-table-entry. Thx to Peter Galbraith. ;; 2010/04/08 dadams ;; Added autoload cookies. Thx to Peter Galbraith. ;; 2009/03/02 dadams ;; Enhancement by Andrey Paramonov. ;; pp^L-^L-display-table-entry: Added window argument. ;; pretty-control-l-mode: Update display table of each window. ;; Add/remove refresh to window-configuration-hook. ;; refresh-pretty-control-l: Just call mode function when turned on. ;; 2009/02/26 dadams ;; Added: pp^L-^L-string-function, refresh-pretty-control-l. ;; pp^L-^L-display-table-entry: Use pp^L-^L-string-function if non-nil. ;; 2008/05/02 dadams ;; pp^L-make-glyph-code: If make-glyph-code exists, use that (alias). ;; 2007/05/28 dadams ;; pp^L-make-glyph-code: Reported Emacs 23 bug to Emacs. ;; Fixed to work also with Emacs 23+, per Kenichi Handa's suggestion. ;; 2007/02/08 dadams ;; Created. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; 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 2, 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; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth ;; Floor, Boston, MA 02110-1301, USA. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Code: ;;;;;;;;;;;;;;;;;;;; ;; Convenience function suggested by Kim Storm to emacs-devel@gnu.org, in response to ;; my email 2007-02-05, subject: "cannot understand Elisp manual node Glyphs". ;; Added to Emacs as `make-glyph-code' starting with Emacs 23. ;; The version here works also for Emacs versions before Emacs 23. ;; The constant passed as second arg to lsh must be the same as constant ;; CHARACTERBITS in `src/lisp.h'. (if (fboundp 'make-glyph-code) (defalias 'pp^L-make-glyph-code 'make-glyph-code) (defun pp^L-make-glyph-code (char &optional face) "Return a glyph code representing char CHAR with face FACE." (if face (logior char (lsh (face-id face) 19)) ; CHARACTERBITS char))) ;;;###autoload (defgroup Pretty-Control-L nil "Options to define pretty display of Control-l (`^L') characters." :prefix "pp^L-" :group 'convenience :group 'wp :link `(url-link :tag "Send Bug Report" ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=pp-c-l.el bug: \ &body=Describe bug here, starting with `emacs -q'. \ Don't forget to mention your Emacs and library versions.")) :link '(url-link :tag "Other Libraries by Drew" "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries") :link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/pp-c-l.el") :link '(url-link :tag "Description" "http://www.emacswiki.org/cgi-bin/wiki/PrettyControlL") :link '(emacs-commentary-link :tag "Commentary" "pp-c-l")) ;;;###autoload (defface pp^L-highlight (if (> emacs-major-version 21) '((((type x w32 mac graphic) (class color)) (:box (:line-width 3 :style pressed-button))) (t (:inverse-video t))) '((((type x w32 mac graphic) (class color)) (:foreground "Blue" :background "DarkSeaGreen1")) (t (:inverse-video t)))) "*Face used to highlight `pp^L-^L-vector'." :group 'Pretty-Control-L :group 'faces) ;;;###autoload (defcustom pp^L-^L-string " Section (Printable Page) " "*Highlighted string displayed in place of each Control-l (^L) character. If `pp^L-^L-string-function' is non-nil, then the string that function returns is used instead of `pp^L-^L-string'." :type 'string :group 'Pretty-Control-L) (defcustom pp^L-^L-string-function nil "*Function to produce string displayed in place of a Control-l (^L) char. The function accepts as argument the window where the ^L is displayed. If the option value is non-nil, option `pp^L-^L-string' is not used. You can use this option to have a dynamically defined display string. For example, this value displays a window-width horizontal line: (lambda (win) (make-string (1- (window-width win)) ?_))" :type '(choice (const :tag "None" nil) function) :group 'Pretty-Control-L) (defcustom pp^L-^L-string-pre (if (> emacs-major-version 21) "\n" "") "*String displayed just before `pp^L-^L-string'. This text is not highlighted." :type 'string :group 'Pretty-Control-L) (defcustom pp^L-^L-string-post "" "*String displayed just after `pp^L-^L-string'. This text is not highlighted." :type 'string :group 'convenience :group 'wp) ;;;###autoload (unless (fboundp 'define-minor-mode) ; Emacs 20. (defcustom pretty-control-l-mode nil "*Toggle pretty display of Control-l (`^L') characters. Setting this variable directly does not take effect; use either \\[customize] or command `pretty-control-l-mode'." :set (lambda (symbol value) (pretty-control-l-mode (if value 1 -1))) :initialize 'custom-initialize-default :type 'boolean :group 'Pretty-Control-L)) ;;;###autoload (defun pp^L-^L-display-table-entry (window) "Returns the display-table entry for Control-l (`^L') char in WINDOW. A vector determining how a Control-l character is displayed in WINDOW. Either a vector of characters or nil. The characters are displayed in place of the Control-l character. nil means `^L' is displayed. In effect, this concatenates `pp^L-^L-string-pre', `pp^L-^L-string', and `pp^L-^L-string-post'." (vconcat (mapconcat (lambda (c) (list c)) pp^L-^L-string-pre "") (mapcar (lambda (c) (pp^L-make-glyph-code c 'pp^L-highlight)) (if pp^L-^L-string-function (funcall pp^L-^L-string-function window) pp^L-^L-string)) (mapconcat (lambda (c) (list c)) pp^L-^L-string-post ""))) (defalias 'pp^l 'pretty-control-l-mode) ;;;###autoload (if (fboundp 'define-minor-mode) ;; Emacs 21 and later. ;; We eval this so that even if the library is byte-compiled with Emacs 20, ;; loading it into Emacs 21+ will define variable `pretty-control-l-mode'. (eval '(define-minor-mode pretty-control-l-mode "Toggle pretty display of Control-l (`^L') characters. With ARG, turn pretty display of `^L' on if and only if ARG is positive." :init-value nil :global t :group 'Pretty-Control-L :link `(url-link :tag "Send Bug Report" ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\ pp-c-l.el bug: \ &body=Describe bug here, starting with `emacs -q'. \ Don't forget to mention your Emacs and library versions.")) :link '(url-link :tag "Other Libraries by Drew" "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries") :link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/pp-c-l.el") :link '(url-link :tag "Description" "http://www.emacswiki.org/cgi-bin/wiki/PrettyControlL") :link '(emacs-commentary-link :tag "Commentary" "pp-c-l") (if pretty-control-l-mode (add-hook 'window-configuration-change-hook 'refresh-pretty-control-l) (remove-hook 'window-configuration-change-hook 'refresh-pretty-control-l)) (walk-windows (lambda (window) (let ((display-table (or (window-display-table window) (make-display-table)))) (aset display-table ?\014 (and pretty-control-l-mode (pp^L-^L-display-table-entry window))) (set-window-display-table window display-table))) 'no-minibuf 'visible))) ;; Emacs 20 (defun pretty-control-l-mode (&optional arg) "Toggle pretty display of Control-l (`^L') characters. With ARG, turn pretty display of `^L' on if and only if ARG is positive." (interactive "P") (setq pretty-control-l-mode (if arg (> (prefix-numeric-value arg) 0) (not pretty-control-l-mode))) (if pretty-control-l-mode (add-hook 'window-configuration-change-hook 'refresh-pretty-control-l) (remove-hook 'window-configuration-change-hook 'refresh-pretty-control-l)) (walk-windows (lambda (window) (let ((display-table (or (window-display-table window) (make-display-table)))) (aset display-table ?\014 (and pretty-control-l-mode (pp^L-^L-display-table-entry window))) (set-window-display-table window display-table))) 'no-minibuf 'visible))) ;;;###autoload (defun refresh-pretty-control-l () "Reinitialize `pretty-control-l-mode', if on, to update the display." (interactive) (when pretty-control-l-mode (pretty-control-l-mode t))) ;;;;;;;;;;;;;;;;;;;; (provide 'pp-c-l) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; pp-c-l.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/xrdb-mode.el0000775000000000000000000004627312230377265021465 0ustar ;;; xrdb-mode.el --- mode for editing X resource database files ;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. ;; Author: 1994-2003 Barry A. Warsaw ;; Maintainer: barry@python.org ;; Created: May 1994 ;; Keywords: data languages (defconst xrdb-version "3.0" "`xrdb-mode' version number.") ;; 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 2 ;; 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, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ;;; Commentary: ;; ;; This file provides a major mode for editing X resource database ;; files. It includes font-lock definitions and commands for ;; controlling indentation, re-indenting by subdivisions, and loading ;; and merging into the the resource database. ;; ;; To use, put the following in your .emacs: ;; ;; (autoload 'xrdb-mode "xrdb-mode" "Mode for editing X resource files" t) ;; ;; You may also want something like: ;; ;; (setq auto-mode-alist ;; (append '(("\\.Xdefaults$" . xrdb-mode) ;; ("\\.Xenvironment$" . xrdb-mode) ;; ("\\.Xresources$" . xrdb-mode) ;; ("*.\\.ad$" . xrdb-mode) ;; ) ;; auto-mode-alist)) ;;; Credits: ;; ;; The database merge feature was inspired by Joel N. Weber II. ;; ;; The canonical Web site for xrdb-mode is ;; ;;; Code: (require 'custom) (defgroup xrdb nil "Support for editing X resource database files" :group 'languages) (defcustom xrdb-mode-hook nil "*Hook to be run when `xrdb-mode' is entered." :type 'hook :group 'xrdb) (defcustom xrdb-subdivide-by 'paragraph "*Default alignment subdivision when re-indenting a region or buffer. This variable controls how much of the buffer is searched to find a goal column on which to align. Every non-comment line in the region defined by this variable is scanned for the first `:' character on the line, and this character's column is the line's goal column. The rightmost line goal column in the region is taken as the region's goal column. This variable can take one of the following symbol values: `buffer' - All lines in the buffer are scanned. This is the slowest option. `paragraph' - All lines in the paragraph are scanned. Paragraphs are delimited by blank lines, comment lines, and page delimiters. `page' - All lines in the page are scanned. Pages are delimited with `page-delimiter', usually ^L (control-L). `line' - Only the previous non-comment line is scanned. This is the fastest method. This variable is used by the various indentation commands, and can be overridden in those commands by using \\[universal-argument]." :type '(radio (const :tag "Do not subdivide buffer" buffer) (const :tag "Subdivide by paragraphs" paragraph) (const :tag "Subdivide by pages" page) (const :tag "Each line is independent" line)) :group 'xrdb) (defcustom xrdb-compress-whitespace nil "*Collapse all whitespace to a single space after insertion of `:'." :type 'boolean :group 'xrdb) (defcustom xrdb-program "xrdb" "*Program to run to load or merge resources in the X resource database." :type 'string :group 'xrdb) (defcustom xrdb-program-args '("-merge") "*List of string arguments to pass to `xrdb-program'." :type '(repeat string) :group 'xrdb) (defvar xrdb-master-file nil "If non-nil, merge in the named file instead of the buffer's file. The intent is to allow you to set this variable in the file's local variable section, e.g.: ! Local Variables: ! xrdb-master-file: \"Xdefaults\" ! End: so that typing \\[xrdb-database-merge-buffer-or-region] in that buffer merges the named master file instead of the buffer's file. Note that if the file name has a relative path, the `default-directory' for the buffer is prepended to come up with a file name. You may also want to set `xrdb-program-args' in the local variables section as well.") (make-variable-buffer-local 'xrdb-master-file) ;; Non-user customizable (defconst xrdb-comment-re "^[ \t]*[!]" "Regular expression describing the beginning of a comment line.") ;; utilities (defun xrdb-point (position) "Return the value of point at certain commonly referenced POSITIONs. POSITION can be one of the following symbols: bol -- beginning of line eol -- end of line bod -- beginning of defun boi -- back to indentation ionl -- indentation of next line iopl -- indentation of previous line bonl -- beginning of next line bopl -- beginning of previous line bop -- beginning of paragraph eop -- end of paragraph bopg -- beginning of page eopg -- end of page This function does not modify point or mark." (let ((here (point))) (cond ((eq position 'bod) (beginning-of-defun)) ((eq position 'bol) (beginning-of-line)) ((eq position 'eol) (end-of-line)) ((eq position 'boi) (back-to-indentation)) ((eq position 'bonl) (forward-line 1)) ((eq position 'bopl) (forward-line -1)) ((eq position 'bop) (forward-paragraph -1)) ((eq position 'eop) (forward-paragraph 1)) ((eq position 'bopg) (forward-page -1)) ((eq position 'eopg) (forward-page 1)) (t (error "Unknown buffer position requested: %s" position))) (prog1 (point) (goto-char here)) )) (defmacro xrdb-safe (&rest body) "Safely execute BODY, return nil if an error occurred." (` (condition-case nil (progn (,@ body)) (error nil)))) (defsubst xrdb-skip-to-separator () "Skip forward. Skip forward from the beginning of the line to the separator character as given by xrdb-separator-char. Returns t if the char was found, otherwise, nil." (beginning-of-line) (skip-chars-forward "^:" (xrdb-point 'eol)) (and (eq (char-after) ?:) (current-column))) (defsubst xrdb-in-comment-p (&optional lim) "True if point is in a comment. Optional argument LIM is passed to `parse-partial-sexp'." (let* ((lim (or lim (xrdb-point 'bod))) (state (parse-partial-sexp lim (point)))) (nth 4 state))) (defsubst xrdb-boi-col () "The current column at the beginning of indentation." (let ((here (point))) (goto-char (xrdb-point 'boi)) (prog1 (current-column) (goto-char here)))) (defvar xrdb-prompt-history nil) (defun xrdb-prompt-for-subdivision () "Prompt for how to subdivide alignment by." (let ((options '(("buffer" . buffer) ("paragraphs" . paragraph) ("pages" . page) ("lines" . line))) (completion-ignore-case t)) (cdr (assoc (completing-read "Subdivide alignment by? " options nil t (cons (format "%s" xrdb-subdivide-by) 0) 'xrdb-prompt-history) options)))) ;; commands (defun xrdb-electric-separator (arg) "Insert a colon, and possibly indent line. Numeric argument inserts that many separators. If the numeric argument is not given, or is 1, and the separator is not inserted in a comment, then the line is indented according to `xrdb-subdivide-by'. Argument ARG inhibits insertion." (interactive "P") (self-insert-command (prefix-numeric-value arg)) ;; only do electric behavior if arg is not given (or arg (xrdb-in-comment-p) (xrdb-indent-line)) ;; compress whitespace (and xrdb-compress-whitespace (just-one-space))) (defun xrdb-electric-bang (arg) "Insert an exclamation point to start a comment. ARG inserts that many exclamation characters. If ARG is not given, or is 1, and the bang character is the first character on a line, the line is indented to column zero." (interactive "P") (let ((how-many (prefix-numeric-value arg))) (self-insert-command how-many) (save-excursion (if (and (= how-many 1) (xrdb-in-comment-p) (memq (char-before (xrdb-point 'boi)) '(?\n nil))) (indent-line-to 0))) )) (defun xrdb-indent-line (&optional arg) "Align the current line according to `xrdb-subdivide-by'. With optional ARG, prompt for subdivision." (interactive "P") (xrdb-align-to-column (xrdb-guess-goal-column (if arg (xrdb-prompt-for-subdivision) xrdb-subdivide-by)) (xrdb-point 'bol) (xrdb-point 'bonl))) (defun xrdb-indent-region (start end &optional arg) "Indent all lines in the region according to `xrdb-subdivide-by'. START and END are the region. With optional ARG, prompt for subdivision." (interactive "r\nP") (xrdb-align-to-column (xrdb-guess-goal-column (if arg (xrdb-prompt-for-subdivision) xrdb-subdivide-by)) start end)) (defun xrdb-indent-page (&optional arg) "Indent all lines in the page according to `xrdb-subdivide-by'. With optional ARG, prompt for subdivision." (interactive "P") (xrdb-align-to-column (xrdb-guess-goal-column (if arg (xrdb-prompt-for-subdivision) xrdb-subdivide-by)) (xrdb-point 'bopg) (xrdb-point 'eopg))) (defun xrdb-indent-paragraph (&optional arg) "Indent all lines in the paragraph according to `xrdb-subdivide-by'. With optional ARG, prompt for subdivision." (interactive "P") (xrdb-align-to-column (xrdb-guess-goal-column (if arg (xrdb-prompt-for-subdivision) xrdb-subdivide-by)) (xrdb-point 'bop) (xrdb-point 'eop))) (defun xrdb-indent-buffer (&optional arg) "Indent all lines in the buffer according to `xrdb-subdivide-by'. With optional ARG, prompt for subdivision." (interactive "P") (let ((subdivide-by (if arg (xrdb-prompt-for-subdivision) xrdb-subdivide-by))) (save-excursion (goto-char (point-min)) (if (eq subdivide-by 'buffer) (xrdb-align-to-column (xrdb-guess-goal-column 'buffer) (point-min) (point-max)) (let (mvfwdfunc indentfunc) (cond ((eq subdivide-by 'paragraph) (setq mvfwdfunc 'forward-paragraph indentfunc 'xrdb-indent-paragraph)) ((eq subdivide-by 'page) (setq mvfwdfunc 'forward-page indentfunc 'xrdb-indent-page)) ((eq subdivide-by 'line) (setq mvfwdfunc 'forward-line indentfunc 'xrdb-indent-page)) (t (error "Illegal alignment subdivision: %s" subdivide-by)) ) (while (< (point) (point-max)) (funcall indentfunc) (funcall mvfwdfunc 1)) ))))) ;; internal alignment functions (defun xrdb-align-to-column (goalcol &optional start end) "Align to column. GOALCOL is the column to try to align to. START and END are the region." (let ((start (or start (xrdb-point 'bol))) (end (or end (xrdb-point 'bonl)))) (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (while (< (point) (point-max)) (if (and (not (looking-at xrdb-comment-re)) (xrdb-skip-to-separator)) (indent-line-to (max 0 (+ goalcol (- (current-column)) (xrdb-boi-col)) ))) (forward-line 1)) )))) (defun xrdb-guess-goal-column (subdivide-by) "Return the goal column of the current line based on SUBDIVIDE-BY. This can be any value allowed by `xrdb-subdivide-by'." (let ((here (point)) (goalcol 0)) (save-restriction (cond ((eq subdivide-by 'line) (while (and (zerop (forward-line -1)) (or (looking-at xrdb-comment-re) (not (xrdb-skip-to-separator))))) ;; maybe we didn't find one (if (not (xrdb-skip-to-separator)) (goto-char here)) (narrow-to-region (xrdb-point 'bol) (xrdb-point 'bonl))) ((eq subdivide-by 'page) (narrow-to-page)) ((eq subdivide-by 'paragraph) (narrow-to-region (xrdb-point 'bop) (xrdb-point 'eop))) ((eq subdivide-by 'buffer)) (t (error "Illegal alignment subdivision: %s" subdivide-by))) (goto-char (point-min)) (while (< (point) (point-max)) (if (and (not (looking-at xrdb-comment-re)) (xrdb-skip-to-separator)) (setq goalcol (max goalcol (- (current-column) (xrdb-boi-col))))) (forward-line 1))) (goto-char here) goalcol)) ;; major-mode stuff (defvar xrdb-mode-abbrev-table nil "Abbreviation table used in `xrdb-mode' buffers.") (define-abbrev-table 'xrdb-mode-abbrev-table ()) (defvar xrdb-mode-syntax-table nil "Syntax table used in `xrdb-mode' buffers.") (if xrdb-mode-syntax-table nil (setq xrdb-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?! "<" xrdb-mode-syntax-table) (modify-syntax-entry ?\\ "\\" xrdb-mode-syntax-table) (modify-syntax-entry ?\n ">" xrdb-mode-syntax-table) (modify-syntax-entry ?/ ". 14" xrdb-mode-syntax-table) (modify-syntax-entry ?* "_ 23" xrdb-mode-syntax-table) (modify-syntax-entry ?. "_" xrdb-mode-syntax-table) (modify-syntax-entry ?# "_" xrdb-mode-syntax-table) (modify-syntax-entry ?? "_" xrdb-mode-syntax-table) (modify-syntax-entry ?< "(" xrdb-mode-syntax-table) (modify-syntax-entry ?> ")" xrdb-mode-syntax-table) ) (defvar xrdb-mode-map () "Keymap used in `xrdb-mode' buffers.") (if xrdb-mode-map () (setq xrdb-mode-map (make-sparse-keymap)) ;; make the separator key electric (define-key xrdb-mode-map ":" 'xrdb-electric-separator) (define-key xrdb-mode-map "!" 'xrdb-electric-bang) (define-key xrdb-mode-map "\t" 'xrdb-indent-line) (define-key xrdb-mode-map "\C-c\C-a" 'xrdb-indent-buffer) (define-key xrdb-mode-map "\C-c\C-b" 'xrdb-submit-bug-report) (define-key xrdb-mode-map "\C-c\C-c" 'xrdb-database-merge-buffer-or-region) (define-key xrdb-mode-map "\C-c\C-p" 'xrdb-indent-paragraph) (define-key xrdb-mode-map "\C-c\[" 'xrdb-indent-page) (define-key xrdb-mode-map "\C-c\C-r" 'xrdb-indent-region) ) ;;;###autoload (defun xrdb-mode () "Major mode for editing xrdb config files. \\{xrdb-mode-map}" (interactive) (kill-all-local-variables) (set-syntax-table xrdb-mode-syntax-table) (setq major-mode 'xrdb-mode mode-name "xrdb" local-abbrev-table xrdb-mode-abbrev-table) (use-local-map xrdb-mode-map) (setq font-lock-defaults '(xrdb-font-lock-keywords)) ;; local variables (make-local-variable 'parse-sexp-ignore-comments) (make-local-variable 'comment-start-skip) (make-local-variable 'comment-start) (make-local-variable 'comment-end) (make-local-variable 'paragraph-start) (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-ignore-fill-prefix) (make-local-variable 'indent-region-function) ;; now set their values (setq parse-sexp-ignore-comments t comment-start-skip "![ \t]*" comment-start "! " comment-end "") (setq indent-region-function 'xrdb-indent-region paragraph-ignore-fill-prefix t paragraph-start (concat "^[ \t]*$\\|^[ \t]*[!]\\|" page-delimiter) paragraph-separate paragraph-start) (run-hooks 'xrdb-mode-hook)) ;; faces and font-locking (defvar xrdb-option-name-face 'xrdb-option-name-face "Face for option name on a line in an X resource db file.") (defvar xrdb-option-value-face 'xrdb-option-value-face "Face for option value on a line in an X resource db file.") (make-face 'xrdb-option-name-face) (make-face 'xrdb-option-value-face) (defun xrdb-font-lock-mode-hook () "Font-lock mode hook." (or (face-differs-from-default-p 'xrdb-option-name-face) (copy-face 'font-lock-keyword-face 'xrdb-option-name-face)) (or (face-differs-from-default-p 'xrdb-option-value-face) (copy-face 'font-lock-string-face 'xrdb-option-value-face)) (remove-hook 'font-lock-mode-hook 'xrdb-font-lock-mode-hook)) (add-hook 'font-lock-mode-hook 'xrdb-font-lock-mode-hook) (defvar xrdb-font-lock-keywords (list '("^[ \t]*\\([^\n:]*:\\)[ \t]*\\(.*\\)$" (1 xrdb-option-name-face) (2 xrdb-option-value-face))) "Additional expressions to highlight in X resource db mode.") (put 'xrdb-mode 'font-lock-defaults '(xrdb-font-lock-keywords)) ;; merging and manipulating the X resource database (defun xrdb-database-merge-buffer-or-region (start end) "Merge the current buffer's resources into the X resource database. `xrdb-program' is the program to actually call, with the arguments specified in `xrdb-program-args'. This latter can be set to do either a merge or a load, etc. Also, if the file local variable `xrdb-master-file' is non-nil, then it is merged instead of the buffer's file. START and END are the region; if the current region is active, it is merged instead of the buffer, and this overrides any use of `xrdb-master-file'." (interactive ;; the idea here is that if the region is inactive, start and end ;; will be nil, if not passed in programmatically (list (xrdb-safe (and (mark) (region-beginning))) (xrdb-safe (and (mark) (region-end))))) (message "Merging with args: %s..." xrdb-program-args) (let ((outbuf (get-buffer-create "*Shell Command Output*"))) ;; I prefer the XEmacs way of doing this, but this is the easiest ;; way to work in both XEmacs and Emacs. (with-current-buffer outbuf (erase-buffer)) (cond ((and start end) (apply 'call-process-region start end xrdb-program nil outbuf t xrdb-program-args)) (xrdb-master-file (apply 'call-process xrdb-program xrdb-master-file outbuf t xrdb-program-args)) (t (apply 'call-process-region (point-min) (point-max) xrdb-program nil outbuf t xrdb-program-args))) (if (not (zerop (with-current-buffer outbuf (buffer-size)))) (pop-to-buffer outbuf))) (message "Merging... done")) ;; submitting bug reports (defconst xrdb-mode-help-address "tools-help@python.org" "Address for `xrdb-mode' bug reports.") (defun xrdb-submit-bug-report () "Submit via mail a bug report on `xrdb-mode'." (interactive) ;; load in reporter (require 'reporter) (let ((reporter-prompt-for-summary-p t) (varlist '(xrdb-subdivide-by xrdb-mode-hook xrdb-compress-whitespace ))) (and (if (y-or-n-p "Do you want to submit a report on xrdb-mode? ") t (message "") nil) (require 'reporter) (reporter-submit-bug-report xrdb-mode-help-address (format "xrdb-mode %s" xrdb-version) varlist nil nil "Dear Barry,") ))) (provide 'xrdb-mode) ;;; xrdb-mode.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/highlight-current-line.el0000775000000000000000000003675112230377265024160 0ustar ;;; highlight-current-line.el --- highlight line where the cursor is. ;; Copyright (c) 1997-2003 Christoph Conrad Time-stamp: <19.09.2003 20:10:05> ;; Author: Christoph Conrad ;; Created: 10 Oct 1997 ;; Version: 0.57 ;; Keywords: faces ;; This file is not yet part of any Emacs. ;; 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 2, 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, write to the Free Software Foundation, Inc., ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ;;; Commentary: ;; Minor mode to highlight the line the cursor is in. You can change colors ;; of foreground (text) and background. The default behaviour is to set ;; only a background color, so that font-lock fontification colors remain ;; visible (syntax coloring). Enable a buffer using the command ;; `highlight-current-line-minor-mode' and customize via: ;; ;; M-x customize-group highlight-current-line . ;; ;; You can select whether the whole line (from left to right window border) ;; is marked or only the really filled parts of the line (from left window ;; border to the last char in the line). The second behaviour is suitable ;; if it's important for you to see trailing spaces or tabs in a ;; line. Customize the variable `highlight-current-line-whole-line' (or use ;; the function `highlight-current-line-whole-line-on' retained for ;; compatibility with prior versions). ;; ;; You may enable the minor-mode automatically for (almost) all buffers by ;; customizing the variable `highlight-current-line-globally' (or using the ;; compatibility command `highlight-current-line-on'). Buffers whose ;; buffer-name match the regular expression in the customizable variable ;; `highlight-current-line-ignore-regexp' do not highlighted. You can ;; extend or redefine this regexp. This works together with the default ;; ignore function `highlight-current-line-ignore-function'. You can ;; redefine this function to implement your own criterias. ;; (The functions `highlight-current-line-on', ;; `highlight-current-line-set-fg-color' and ;; `highlight-current-line-set-bg-color' are retained for backward ;; compatibility. There's a special color "none" defined to set no color.) ;;; People which made contributions or suggestions: ;; This list is ordered by time. Latest in time first. ;; - Peter S Galbraith ;; - Masatake Yamato ;; - Hrvoje Niksic ;; - Jari Aalto ;; - Shawn Ostermann ;; - Peter Ikier ;; Many thanks to him for the idea. He liked this behaviour in another ;; editor ("Q"). ;;; Installation: ;; ;; Put a copy of highlight-current-line.el/.elc into some path of ;; `load-path'. To show `load-path': load-path RET ;; ;; Load the file, e.g. add in ~/.emacs ;; ;; (require 'highlight-current-line) ;; ;; Enable it on a buffer using `M-x highlight-current-line-minor-mode' ;; or globally by customizing `highlight-current-line-globally'. ;; ;; Previous versions of this code worked by adding other comamnds in ;; ~/.emacs instead of using the custom interface. This is still ;; supported: ;; ;; ;; If you want to mark only to the end of line: ;; (highlight-current-line-whole-line-on nil) ;; ;; switch highlighting on ;; (highlight-current-line-on t) ;; ;; Ignore no buffer ;; (setq highlight-current-line-ignore-regexp nil) ; or set to "" ;; ;; alternate way to ignore no buffers ;; (fmakunbound 'highlight-current-line-ignore-function) ;; ;; Ignore more buffers ;; (setq highlight-current-line-ignore-regexp ;; (concat "Dilberts-Buffer\\|" ;; highlight-current-line-ignore-regexp)) ;;; Troubleshooting: ;; - Q: I do not see matching parens from paren.el any more! ;; - A: Check the colors from highlight-current-line or from show-paren-face ;; and choose some combination which works together. ;;; ToDo: ;; - highlight paragraphs, functions etc... (suggestion by Daniel Lundin ;; 19 Dec 1999) ;; - provide overlay priorities ;; (overlay-put highlight-current-line-overlay 'priority 60) ;; - better way to switch off 'ignore buffer' ;; - face fore/backgroundcolor depending on major-mode ;; - better way to detect xemacs ;; - some suggestions for default keys ;; - highlight-current-line as minor mode. Suggested by Shawn Ostermann. ;;; Change log: ;; 10 Sept 2003 - v0.57 ;; - highlight-current-line-minor-mode created. ;; - highlight-current-line-globally defcustom added. ;; 7 Sept 2003 - v0.56 ;; - defface for highlight-current-line-face with customization. ;; Thanks to Peter S. Galbraith for the suggestion. Retained ;; highlight-current-line-set-fg/bg-color for backward ;; compatibility. ;; 7 Sept 2003 - v0.55 ;; - v0.54 change works now correctly ;; 22 Mar 2003 - v0.54 ;; - don't highlight lines which contain faces specified in ;; highlight-current-line-high-faces. Elisp manual: "Currently, all ;; overlays take priority over text properties." So, if a text ;; property is a face, highlight-current-line always hides that face. ;; 12 Mar 2002 - v0.53 ;; - updated email address ;; 05 Feb 2001 ;; - highlight-current-line-ignore-regexp: better regexp for minibuffers ;; 15 Jul 2000 - v0.52: ;; - Masatake YAMATO: added emacsclient / gnudoit support. Invoking emacs ;; to load a file from external, highlight-current-line couldn't ;; initially show the line of the loaded file highlighted. ;; 19 Oct 1997 - v0.51: ;; - uses defcustom-library if available. Suggested by Jari Aalto and Hrvoje ;; Niksic. ;; - logic error in if-condition of post-command-hook. All Buffers were ;; ignored if highlight-current-line-ignore-function was unbound. ;; 18 Oct 1997 - v0.5: ;; - GNU General Public License ;; - ignore user-definable buffernames which are ignored for ;; highlighting. Suggested by Jari Aalto. ;; - works with XEmacs, at least version 19.15. Mark whole line doesnt work ;; yet. Suggested by Jari Aalto. ;; - highlight-current-line-set-fg/bg-color understand "none" as color ;; - overlay-put moved from post-command-hook to initialization-code ;; - version-variable: `highlight-current-line-version'. Always ;; "major.minor". Suggested by Jari Aalto. ;; 11 Oct 1997 - v0.4: ;; - Possibility to highlight whole line (from left to right windowborder) or ;; only from left window border to the last char in the line. ;; ;; 20 Aug 1997 - v0.3: ;; - First public released version. ;;; Code: ;; Initialization for XEmacs ;; XEmacs needs overlay emulation package. ;; Old XEmacs won't have the package and we must quit. (eval-and-compile (if (boundp 'xemacs-logo) (if (not (load "overlay" 'noerr)) (error "\ highlight-current-line.el: ** This package requires overlays. Abort")))) ;; Compatibility code - blob for those without the custom library: (eval-and-compile (condition-case () (require 'custom) (error nil)) (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) nil ;; We've got what we needed ;; We have the old custom-library, hack around it! (defmacro defgroup (&rest args) nil) (defmacro defcustom (var value doc &rest args) (` (defvar (, var) (, value) (, doc)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; can be set by user (defgroup highlight-current-line nil "Highlight line where the cursor is." :load 'highlight-current-line :group 'faces) ;; or 'matching?? (defcustom highlight-current-line-ignore-regexp (concat "Faces\\|Colors\\| \\*Mini" ;; for example: ;; "\\|RMAIL.*summary\\|\\*Group\\|\\*Summary" ) "*Regexps for buffers to ignore. Used by `highlight-current-line-ignore-function'." :type 'regexp :group 'highlight-current-line) (defcustom highlight-current-line-whole-line t "*If non-nil, mark up to `end-of-line'. If nil, mark up to window-border. Use `highlight-current-line-whole-line-on' to set this value." :type 'boolean :group 'highlight-current-line) (defcustom highlight-current-line-high-faces '() "*Lines containing one of this faces are not highlighted." :type 'list :group 'highlight-current-line) (defface highlight-current-line-face '((t (:background "wheat"))) "Face used to highlight current line." :group 'highlight-current-line) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; should not be set by user (defconst highlight-current-line-version "0.57" "Version number." ) (defvar highlight-current-line-minor-mode nil "Non-nil if using highlight-current-line mode as a minor mode. Use the command `highlight-current-line-minor-mode' to toggle or set this variable.") (make-variable-buffer-local 'highlight-current-line-minor-mode) (defvar highlight-current-line-overlay ;; Dummy initialization (make-overlay 1 1) "Overlay for highlighting.") ;; Set face-property of overlay (overlay-put highlight-current-line-overlay 'face 'highlight-current-line-face) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal function for test (defun highlight-current-line-reload () "Reload library highlight-current-line for test purposes." (unload-feature 'highlight-current-line) (load-library "highlight-current-line")) ;; Decide whether to highlight the buffer. (defun highlight-current-line-ignore-function () "Check current buffer name against `highlight-current-line-ignore-regexp'. Inhibits global enabling of highlight-current-line on buffer whose name match this regexp." (if (or (equal "" highlight-current-line-ignore-regexp) (not highlight-current-line-ignore-regexp)) nil (string-match highlight-current-line-ignore-regexp (buffer-name)))) (defvar highlight-current-line-globally) ;; Post-Command-Hook for highlighting (defun highlight-current-line-hook () "Post-Command-Hook for highlighting." (condition-case () (if (or highlight-current-line-minor-mode (and highlight-current-line-globally (or (not (fboundp 'highlight-current-line-ignore-function)) (not (highlight-current-line-ignore-function))))) (let ((current-point (point))) ;; Set overlay (let ((beg (progn (beginning-of-line) (point))) (end (progn (if highlight-current-line-whole-line (forward-line 1) (end-of-line)) (point)))) (if (delete nil (mapcar (lambda( face ) (text-property-any beg end 'face face)) highlight-current-line-high-faces)) (delete-overlay highlight-current-line-overlay) (move-overlay highlight-current-line-overlay beg end (current-buffer))) (goto-char current-point)))) (error nil))) (defconst highlight-current-line-no-color (if (boundp 'xemacs-logo) '[] nil) "'color' value that represents \"no color\".") ;; Compatibility code (defun highlight-current-line-on (&optional on-off) "Switch highlighting of cursor-line on/off globally. Key: \\[highlight-current-line-on]" (interactive (list (y-or-n-p "Highlight line with cursor? "))) (setq-default highlight-current-line-globally on-off) (highlight-current-line on-off nil)) ;; Compatibility code - Set foregroundcolor of cursor-line. (defun highlight-current-line-set-fg-color (color) "Set foregroundcolor for highlighting cursor-line to COLOR. Key: \\[highlight-current-line-set-fg-color]" (interactive "sForeground color (\"none\" means no color): ") (if (equal "none" color) (setq color highlight-current-line-no-color)) (set-face-foreground 'highlight-current-line-face color)) ;; Compatibility code - Set backgroundcolor of cursor-line. (defun highlight-current-line-set-bg-color (color) "Set backgroundcolor for highlighting cursor-line to COLOR. Key: \\[highlight-current-line-set-bg-color]" (interactive "sBackground color (\"none\" means no color): ") (if (equal "none" color) (setq color highlight-current-line-no-color)) (set-face-background 'highlight-current-line-face color)) ;; Compatibility code - Enable/Disable whole line marking (defun highlight-current-line-whole-line-on (&optional on-off) "Switch highlighting of whole line ON-OFF. Key: \\[highlight-current-line-whole-line-on]" (interactive (list (y-or-n-p "Highlight whole line? "))) (setq highlight-current-line-whole-line on-off)) ;; Enable/Disable Highlighting (defun highlight-current-line (&optional on-off local) "Switch highlighting of cursor-line ON-OFF If LOCAL is non-nil, do so locally for the current buffer only." (cond (on-off (if (or (= emacs-major-version 20) (string-match "XEmacs" emacs-version)) (make-local-hook 'post-command-hook)) (add-hook 'post-command-hook 'highlight-current-line-hook nil local) (if (boundp 'server-switch-hook) (add-hook 'server-switch-hook 'highlight-current-line-hook nil local)) (if (boundp 'gnuserv-visit-hook) (add-hook 'gnuserv-visit-hook 'highlight-current-line-hook nil local))) (t (if (boundp 'server-switch-hook) (remove-hook 'server-switch-hook 'highlight-current-line-hook local)) (if (boundp 'gnuserv-visit-hook) (remove-hook 'gnuserv-visit-hook 'highlight-current-line-hook local)) (remove-hook 'post-command-hook 'highlight-current-line-hook t) (delete-overlay highlight-current-line-overlay)))) ;;;###autoload (defun highlight-current-line-minor-mode (&optional arg) "Toggle highlight-current-line minor mode. With ARG, turn minor mode on if ARG is positive, off otherwise. You can customize the face of the highlighted line and whether the entire line is hightlighted by customizing the group highlight-current-line." (interactive "P") (setq highlight-current-line-minor-mode (if (null arg) (not highlight-current-line-minor-mode) (> (prefix-numeric-value arg) 0))) (if highlight-current-line-minor-mode (highlight-current-line t t) (highlight-current-line nil t))) (or (assq 'highlight-current-line-minor-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist (list '(highlight-current-line-minor-mode " hcl"))))) (defcustom highlight-current-line-globally nil "*Whether to enable `highlight-current-line-minor-mode' automatically. This affects only files visited after this variable is set. Buffers will not be enabled if they match the regular expression in `highlight-current-line-ignore-regexp'." :type 'boolean :require 'highlight-current-line :set (lambda (symbol value) (set-default symbol value) (if value (highlight-current-line t nil) (highlight-current-line nil nil))) :group 'highlight-current-line) (provide 'highlight-current-line) ;;; highlight-current-line.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/highlight-completion.el0000775000000000000000000016705612230377265023725 0ustar ;;; highlight-completion.el --- completion with highlighted provisional text ;; Copyright (c) 1991-1996 Mark Haiman, Nick Reingold, John Palmieri ;; Copyright (c) 1997-2001 John Palmieri ;; ;; Author: John Palmieri ;; URL: http://www.math.washington.edu/~palmieri/Emacs/hlc.html ;; Keywords: completion ;; Version: 0.08 of Fri Sep 30 12:59:03 PDT 2005 ;; ;; This file is not part of GNU Emacs. ;; ;; This package 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 2, or (at your option) ;; any later version. ;; ;; This package 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; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This package is based on the lightning completion package, ;; written by Mark Haiman and Nick Reingold, then modified by me. I ;; am the author of this package, so any problems are completely ;; my fault. All the good parts probably came from Mark and Nick's ;; original code... ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Description: ;; ;; This package modified how Emacs performs completions. Ordinarily, ;; if you are typing a file name into the minibuffer (after hitting ;; C-x C-f, say), if you type a few letters and hit the TAB key, then ;; Emacs completes as far as possible. For example, suppose the ;; directory contains only these files: ;; filbert filibuster frank grunge.tex ;; If you type 'g' followed by TAB, then 'runge.tex' is inserted. If ;; you hit 'fi' then TAB, an 'l' is inserted. If you hit 'f' then TAB, ;; there is no unique continuation of the file name, so Emacs opens up ;; a new window displaying the list of possible completions. ;; ;; That's the old system. This package provides a variant: if you ;; type 'g', then 'runge.tex' is automatically inserted as highlighted ;; text, to indicate that it's only provisional. The point remains ;; immediately after the 'g'. If you hit TAB, the point jumps to the ;; end, and the added text is no longer highlighted. (So if you ;; weren't looking at the screen, you wouldn't know that anything ;; different had happened.) If after hitting 'g', you typed 'a' ;; (because you wanted to find a new file 'gaptooth.el') the ;; highlighted text would disappear. The effects of various keys: ;; TAB: jump forward to the end of the highlighted text. If no ;; text is highlighted, open up a window showing possible ;; completions. ;; SPC: jump forward a word (so 'g' followed by SPC would yield ;; 'grunge.tex', with the point after the '.', and with 'tex' ;; highlighted). If no text is highlighted, open up a window ;; showing possible completions. ;; ?: open up a window showing possible completions. ;; RET: open the named file (so 'g' followed by RET would open ;; 'grunge.tex'). ;; C-g: delete the highlighted text and stop this modified ;; completion process (and exit the minibuffer, if you're in the ;; minibuffer). ;; C-c: delete the highlighted text and stop this modified ;; completion process. ;; character: if consistent with completion, unhighlight it and ;; move the point forward. if inconsistent, insert the ;; character and delete the highlighted text, stopping this ;; completion process. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; How to use: ;; ;; 1. Put this file (i.e., "highlight-completion.el") in your load-path. ;; 2. Put ;; (require 'highlight-completion) ;; in your .emacs file (or your .xemacs/init.el file) ;; 3. Turn on highlight completion by either running ;; M-x highlight-completion-mode ;; or putting this in your .emacs file: ;; (highlight-completion-mode 1) ;; or customizing variables: ;; M-x customize-group highlight-completion ;; Then turn on "Highlight completion mode". ;; You may want to modify some of the entries in "Highlight completion list". ;; 4. You can also run the functions ;; hc-complete-file-name to complete file names ;; hc-complete-lisp-function lisp functions ;; hc-complete-lisp-variable lisp variables ;; hc-complete-kill-ring contents of kill ring ;; hc-complete-buffer-contents buffer contents ;; hc-complete-word words, using ispell ;; These functions can be used anywhere, not just in the ;; minibuffer. If the variable hc-ctrl-x-c-is-completion is ;; non-nil, then these functions are bound to keys, with prefix ;; `C-x c' (not to be confused with `C-x C-c', of course). See the ;; documentation of that customizable variable for more ;; information. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; In case you want to write a function that uses highlight completion ;; in some other setting, you will want to base your function on the ;; all-purpose completion function ;; ;; hc-completing-insert ;; ;; See its documentation string for a description. The function ;; hc-ispell-complete-word provides a good example of how to use ;; this when there is an easily available list of possible ;; completions. The ispell package provides the function lookup-words ;; which does this. To use this with lightning completion, one only ;; has to write a function that acts as a wrapper for lookup-words and ;; is suitable for use as the TABLE argument in hc-completing-insert. ;; ;; Completion on buffer contents is another, more involved, example. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Lightning completion, on which this is based, works with a package ;; called Ultra-TeX to provide dynamic completion of TeX commands. I ;; will work on adding highlight completion as an option for ;; Ultra-TeX mode. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Version history ;; ;; 0.01 (30-May-2001) first version. ;; 0.02 (30-May-2001) tinkering. ;; 0.03 (31-May-2001) tinkering. ;; 0.04 (31-May-2001) use overlays instead of text-properties in GNU Emacs. ;; 0.05 (21-Jun-2001) add function hc-ispell-complete-word ;; 0.06 (21-Jun-2001) new customization procedure. see above. some ;; bug fixes, too. ;; 0.07 (22-Jun-2001) renamed `hc-completing-insert-BLAH' to `hc-complete-BLAH'. ;; also added a bit more documentation. ;; 0.08 (30-Sep-2005) bug fix for GNU Emacs version 22. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst hc-version-string "0.07" "Version of highlighting completion package.") (defconst hc-version hc-version-string "Version of highlighting completion package.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Customization ;; (defgroup highlight-completion nil "Highlight completion mode: display completion as highlighted text." :tag "Highlight completion" :prefix "hc" :link '(url-link :tag "Home Page" "http://www.math.washington.edu/~palmieri/Emacs/hlc.html") :group 'abbrev) (defconst hc-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version) "Non-nil if using XEmacs.") (defconst hc-emacs-20-p (and (boundp 'emacs-major-version) (= emacs-major-version 20)) "Non-nil if using Emacs 20.") (defconst hc-emacs-21-p (and (boundp 'emacs-major-version) (not hc-xemacs-p) (>= emacs-major-version 21)) "Non-nil if using GNU Emacs 21 or later.") (defcustom highlight-completion-mode nil "Toggle whether `highlighting' is on. If on, you may want to customize highlight-completion-list to specify contexts in which to use highlighting. If off, you can still run functions like hc-complete-file-name or hc-complete-a-la-mode to use this completion." :type '(boolean) :set (lambda (symbol value) (highlight-completion-mode (if value 1 -1))) :initialize 'custom-initialize-default :require 'highlight-completion :group 'highlight-completion) (defun highlight-completion-mode (&optional prefix) "Activate highlight-completion. Deactivates with negative universal argument." (interactive "p") (or prefix (setq prefix 0)) (cond ((>= prefix 0) (setq highlight-completion-mode t) (add-hook 'minibuffer-setup-hook 'highlight-completion-setup)) (t (setq highlight-completion-mode nil)))) (defconst highlight-completion-list-default '((files . t) (functions . t) (commands . t) (variables . t) (user-variables . t) (lisp-objects . t) (info-menu-items . t) (buffers . t) (query . nil) (misc . nil)) "default value of highlight-completion-list") (defun hc-convert-completion-list (list) "Convert LIST (which should be highlight-completion-list-external) to a list of (symbol . boolean) pairs." (let ((hc-list highlight-completion-list-default) (temp list) answer) (if (< (length temp) (length hc-list)) (setq temp (append temp (make-list (- (length hc-list) (length temp)) nil)))) (while hc-list (setq answer (cons (cons (caar hc-list) (car temp)) answer) hc-list (cdr hc-list) temp (cdr temp))) (reverse answer))) (defun hc-unconvert-completion-list (list) "Convert LIST (which should be highlight-completion-list) to a list of boolean values." (mapcar 'cdr list)) (defcustom highlight-completion-list-external (hc-unconvert-completion-list highlight-completion-list-default) "Enable highlighting completion in specific contexts. If nil, turn off completion in that context. If t, turn on completion. The contexts are reasonably self-explanatory: `Files' means file name completion (e.g., after `C-x C-f'). `Functions' means lisp function completion (e.g., after `C-h f'). `Commands' means command completion (e.g., after `M-x'). `Variables' means lisp variable completion (e.g., after `C-h v'). `User variables' means completion on `user variables'--see the documentation for the function `user-variable-p', for instance, to see what this means. `Lisp objects' means both funtions and variables. `Info menu items' is what it says (e.g., after hitting `m' in info mode). `Buffer names' is what it says (e.g., after hitting `C-x C-b'). `Query replace' means: complete on contents of the current buffer when asking for a string to replace when running query-replace (`M-%'). `Miscellany' means: complete on whatever seems appropriate when Emacs knows how to complete (e.g., in gnus, if you hit `j' to run `gnus-jump-to-group', this will complete on group names)." :tag "Highlight completion list" :type '(list (boolean :tag "Files ") (boolean :tag "Functions ") (boolean :tag "Commands ") (boolean :tag "Variables ") (boolean :tag "User variables ") (boolean :tag "Lisp objects ") (boolean :tag "Info menu items") (boolean :tag "Buffer names ") (boolean :tag "Query replace ") (boolean :tag "Miscellany ")) :set (lambda (symbol value) (setq highlight-completion-list (hc-convert-completion-list value)) (set symbol value)) :group 'highlight-completion) (defvar highlight-completion-list (hc-convert-completion-list highlight-completion-list-external) "List of things on which to complete. This is a list, each element of which looks like (SITUATION) or (SITUATION . t). In the former case, highlighting completion is off in SITUATION, and in the latter case, highlighting completion is on in SITUATION. You can modify this list directly, but it is better customize it.") (defcustom hc-ignored-file-extensions-external completion-ignored-extensions "File extensions to ignore when doing highlight completion" :type '(repeat string) :tag "Hc Ignored File Extensions" :set (lambda (symbol value) (setq hc-ignored-file-extensions (concat "\\(" (mapconcat 'regexp-quote value "\\|") "\\)$")) (set symbol value)) :group 'highlight-completion) (defvar hc-ignored-file-extensions (concat "\\(" (mapconcat 'regexp-quote hc-ignored-file-extensions-external "\\|") "\\)$") "Regular expression of file extensions to ignore when doing highlight completion.") (defcustom hc-word-connectors-external '("." "-" "/") "Characters which will be added automatically when completing a word." :type '(repeat string) :tag "Hc Word Connectors" :set (lambda (symbol value) (setq hc-word-connectors (concat "\\(" (mapconcat 'regexp-quote value "\\|") "\\)")) (set symbol value)) :group 'highlight-completion) (defvar hc-word-connectors (concat "\\(" (mapconcat 'regexp-quote hc-word-connectors-external "\\|") "\\)$") "Regular expression of characters to be added to the end when completing a word.") (defvar hc-completions-map (make-sparse-keymap) "Key map for highlight completion functions.") (defcustom hc-ctrl-x-c-is-completion nil "Toggle whether `C-x c' is the prefix key for the various highlight completion commands. If on, C-x c b runs hc-complete-buffer-name C-x c f runs hc-complete-lisp-function C-x c F runs hc-complete-file-name C-x c i runs hc-complete-word C-x c k runs hc-complete-kill-ring C-x c u runs hc-complete-a-la-mode C-x c v runs hc-complete-lisp-variable C-x c y runs hc-complete-buffer-contents C-x c C-h lists all of the key bindings starting with C-x c These functions do completion on the appropriate thing in any buffer, not just the minibuffer. This is useful for typing file names or lisp functions or whatever. If turned off, `C-x c' does nothing." :type '(boolean) :set (lambda (symbol value) (if value (define-key ctl-x-map "c" hc-completions-map) (define-key ctl-x-map "c" nil)) (set symbol value)) :group 'highlight-completion) (define-key hc-completions-map "f" 'hc-complete-lisp-function) (define-key hc-completions-map "v" 'hc-complete-lisp-variable) (define-key hc-completions-map "o" 'hc-complete-lisp-object) (define-key hc-completions-map "F" 'hc-complete-file-name) (define-key hc-completions-map "u" 'hc-complete-a-la-mode) (define-key hc-completions-map "b" 'hc-complete-buffer-name) (define-key hc-completions-map "k" 'hc-complete-kill-ring) (define-key hc-completions-map "y" 'hc-complete-buffer-contents) (define-key hc-completions-map "i" 'hc-complete-word) (defcustom hc-ctrl-backslash-completes-a-la-mode nil "Toggle whether `C-\\' runs the `hc-complete-a-la-mode'. If turned on, `C-\\' runs this function, which turns on highlighting completion. This is helpful in the minibuffer, for instance, if the completion process has stopped and you want to start it up again---just hit `C-\\'. If turned off, `C-\\' does nothing." :type '(boolean) :set (lambda (symbol value) (if value (global-set-key "\C-\\" 'hc-complete-a-la-mode) (global-set-key "\C-\\" nil)) (set symbol value)) :group 'highlight-completion) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Set up hc-mode, hc-mode-map, etc. ;; (defvar hc-mode nil "Non-nil if using Highlight mode as a minor mode") (make-variable-buffer-local 'hc-mode) (or (assq 'hc-mode minor-mode-alist) (setq minor-mode-alist (cons '(hc-mode " Highlight") minor-mode-alist))) (defvar hc-mode-map nil "Minor mode map for highlighting completion.") (if hc-mode-map nil (let ((i 31) (map (copy-keymap minibuffer-local-completion-map)) (meta-map (make-keymap))) (set-keymap-parent map nil) (substitute-key-definition 'switch-to-completions 'hc-switch-to-completions map) (substitute-key-definition 'switch-to-completions 'hc-switch-to-completions map minibuffer-local-map) (substitute-key-definition 'advertised-switch-to-completions 'hc-advertised-switch-to-completions map) (substitute-key-definition 'advertised-switch-to-completions 'hc-advertised-switch-to-completions map minibuffer-local-map) (defalias 'hc-advertised-switch-to-completions 'hc-switch-to-completions) (substitute-key-definition 'exit-minibuffer 'hc-exit-and-then map) (substitute-key-definition 'exit-minibuffer 'hc-exit-and-then map minibuffer-local-map) (substitute-key-definition 'keyboard-quit 'hc-keyboard-quit map) (substitute-key-definition 'keyboard-quit 'hc-keyboard-quit map minibuffer-local-map) (substitute-key-definition 'abort-recursive-edit 'hc-exit-and-then map) (substitute-key-definition 'abort-recursive-edit 'hc-exit-and-then map minibuffer-local-map) (substitute-key-definition 'minibuffer-keyboard-quit 'hc-keyboard-quit map) (substitute-key-definition 'minibuffer-keyboard-quit 'hc-keyboard-quit map minibuffer-local-map) (substitute-key-definition 'next-history-element 'hc-exit-and-then map) (substitute-key-definition 'next-history-element 'hc-exit-and-then map minibuffer-local-map) (substitute-key-definition 'previous-history-element 'hc-exit-and-then map) (substitute-key-definition 'previous-history-element 'hc-exit-and-then map minibuffer-local-map) (substitute-key-definition 'minibuffer-complete 'hc-try-to-complete map) (substitute-key-definition 'minibuffer-completion-help 'hc-display-completions map) (if (keymapp (lookup-key map [menu-bar minibuf])) (progn (define-key map [menu-bar highlight] (cons "Highlight" (make-sparse-keymap "Highlight"))) (define-key map [menu-bar highlight tab] '("List Completions" . hc-display-completions)) (defalias 'hc-exit-and-then-alias 'hc-exit-and-then) (define-key map [menu-bar highlight quit] '("Quit" . hc-exit-and-then-alias)) (define-key map [menu-bar highlight return] '("Enter" . hc-exit-and-then-alias)) (define-key map [menu-bar minibuf] 'undefined))) (define-key map [escape] meta-map) (while (<= (setq i (1+ i)) 126) (or (lookup-key map (vector (list 'control i))) (define-key map (vector (list 'control i)) 'hc-exit-and-then)) (or (lookup-key map (vector (list 'meta i))) (progn (define-key meta-map (char-to-string i) 'hc-exit-and-then) (define-key map (vector (list 'meta i)) 'hc-exit-and-then))) (unless (string= (char-to-string i) "?") (define-key map (char-to-string i) 'hc-self-insert-char))) (define-key map [return] 'hc-exit-and-then) (define-key map [linefeed] 'hc-exit-and-then) (define-key map [(control j)] 'hc-exit-and-then) (define-key map [(control g)] 'hc-keyboard-quit) (define-key map [(control m)] 'hc-exit-and-then) (define-key map (char-to-string 127) 'hc-exit-and-then) (define-key map " " 'hc-keep-if-complete) (define-key map [space] 'hc-keep-if-complete) (define-key map [backspace] 'hc-delete) (substitute-key-definition 'delete-backward-char 'hc-delete map) (substitute-key-definition 'delete-backward-char 'hc-delete map global-map) (define-key map [tab] 'hc-try-to-complete) (define-key map [(control c)] 'hc-quit) (setq hc-mode-map map))) (defvar hc-completion-list-mode-map nil "Local map for completion list buffers (for use with highlighting completion).") (or hc-completion-list-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'hc-mouse-choose-completion) (define-key map [down-mouse-2] nil) (define-key map "\C-m" 'hc-choose-completion) (define-key map "\e\e\e" 'delete-completion-window) (define-key map [left] 'previous-completion) (define-key map [right] 'next-completion) (setq hc-completion-list-mode-map map))) (and (boundp 'minor-mode-map-alist) (or (assq 'hc-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'hc-mode hc-mode-map) minor-mode-map-alist)))) (make-variable-buffer-local 'hc-mode-map) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; miscellaneous variables ;; (defvar hc-stack nil) (make-variable-buffer-local 'hc-stack) (defvar hc-original-text nil) (make-variable-buffer-local 'hc-original-text) (defvar hc-highlighted-text nil) (make-variable-buffer-local 'hc-highlighted-text) (defvar hc-table nil) (make-variable-buffer-local 'hc-table) (defvar hc-predicate nil) (make-variable-buffer-local 'hc-predicate) (defvar hc-hook nil) (make-variable-buffer-local 'hc-hook) (defvar hc-prev-windows nil) ; state before completions window (defvar hc-display-filter nil) (make-variable-buffer-local 'hc-display-filter) (defvar hc-last-display-time nil) ; "time" measured by stack top eq-ness ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; main functions ;; (defun hc-completing-insert (table pred init &optional hook message display) "Highlight-complete string before point in the buffer, relative to completion TABLE; allowing only completions that satisfy PRED. These are used exactly as they are by `completing-read', which means this: TABLE may be an alist, an obarray, or a function-symbol. For an alist, PRED applies to the entries (conses). For an obarray, PRED applies to the symbols. A function symbol will be called with a STRING as first arg, PRED as second arg and third arg nil, t, or `lambda'; according to third arg, the function is supposed to return the common completion of STRING, all its completions, or the truth-value of its completeness. In particular the function can be like 'read-file-name-internal, with PRED the name of a directory. Third arg INIT is the number of characters before point to complete as the initial string. Barf immediately if this is no match. If negative, we are resuming, so return nil unless situation at last quit agrees with buffer before point; then restore that situation. Optional arg HOOK is run on successful completion; gets same kind of argument as PRED, or the complete string if TABLE is a function symbol. On entering, message \"Completing ...\" is displayed. Optional arg DISPLAY is a function to call on each possible completion before displaying. If the DISPLAY function returns nil, that string is NOT displayed." (condition-case nil (if (not (or (and (>= init 0) ; starting fresh (prog1 ; if so, reset things and be t t (setq hc-stack nil) (let ((grab (buffer-substring-no-properties (- (point) init) (point))) (n 0)) (if (eq table 'hc-read-file-name-internal) (setq hc-original-text grab grab (hc-expand-file-name grab) init (length grab))) (while (<= n init) (setq hc-stack (cons (substring grab 0 n) hc-stack)) (setq n (1+ n)))) ; completions=part grabs (setq hc-table table hc-predicate pred hc-hook hook hc-display-filter display))) ;; see if resuming state is consistent: (and hc-stack (and (>= (point) (+ (point-min) (length (car hc-stack)))) (string= (car hc-stack) (buffer-substring-no-properties (- (point) (length (car hc-stack))) (point)))) (eq table hc-table) (equal pred hc-predicate) (equal hook hc-hook) (equal display hc-display-filter)))) nil ; trying to resume inconsistently (setq hc-mode t) (add-hook 'mouse-leave-buffer-hook (function (lambda nil (hc-quit 'mouse)))) (set-buffer-modified-p (buffer-modified-p)) ; update mode line (setq hc-prev-windows (current-window-configuration)) (if (or (> 0 init) (string= (car hc-stack) "") ; don't try to complete "" (let ((stat (hc-complete-stack-top ""))) (or (stringp stat) (prog1 nil (hc-quit stat))))) (progn (while nil))) ; no-op t) ; return t except for bad resume (quit (setq unread-command-events (list (hc-character-to-event ?\C-g)))))) ;; bound to [(control c)], and also called by other functions (defun hc-quit (arg &optional quick) "Exit highlight completion mode. ARG nil means because of error. ARG t means because successful. ARG other means intentional quit without being complete. Interactively, you get the last." (interactive '(lambda)) (remove-hook 'mouse-leave-buffer-hook (function (lambda nil (hc-quit 'mouse)))) (set-buffer-modified-p (buffer-modified-p)) ; update mode line (add-hook 'minibuffer-setup-hook 'highlight-completion-setup) (setq hc-mode nil) (or arg (ding)) ; yell if an error (or (eq arg 'mouse) (and hc-prev-windows (or (null hc-xemacs-p) (null (minibuffer-window-active-p (minibuffer-window)))) (progn (set-window-configuration hc-prev-windows) (setq hc-prev-windows nil)))) (and (eq arg 'choose) (looking-at (regexp-quote (car hc-stack))) (forward-char (length (car hc-stack)))) (if (or (eq arg t) (eq arg 'choose)) (let ((name (car hc-stack))) (setq hc-stack nil) ; no resume after success (if hc-hook ; on success, call possible hook (funcall hc-hook (cond ((vectorp hc-table) ; table is an obarray (intern-soft name hc-table)) ((listp hc-table) ; table is an alist (assoc name hc-table)) (t name)))) ; table is a function (if (> (current-column) fill-column) (run-hooks 'auto-fill-hook))) ;; unsuccessful quit: (setq hc-last-display-time nil)) (unless (eq arg 'keep) (delete-char (length hc-highlighted-text))) (hc-unhighlight) (setq hc-stack nil) (setq hc-highlighted-text nil)) (defun hc-switch-stack-top (str &optional char) "Replace top of stack with STR, fixing buffer. If optional arg CHAR is 't, then modify highlighting etc as though a printable character were hit: add just a single character to the stack and re-highlight. If CHAR is a string, then add all of STR to the stack and highlight CHAR--this is used by hc-complete-word." (let ((inhibit-quit t)) (hc-unhighlight) (if hc-original-text (delete-backward-char (length hc-original-text)) (delete-backward-char (length (car hc-stack)))) (setq hc-original-text nil) (insert str) (if hc-highlighted-text (delete-char (length hc-highlighted-text))) (if char (progn (if (stringp char) (progn (setq hc-highlighted-text char) (save-excursion (insert hc-highlighted-text)) (hc-highlight (point) (+ (point) (length hc-highlighted-text))) (setcar hc-stack str)) (if (< (length (car hc-stack)) (length str)) (progn (forward-char (- (length (car hc-stack)) (length str))) (if (< (point) (point-max)) (progn (setq hc-highlighted-text (substring str (length (car hc-stack)))) (hc-highlight (point) (+ (point) (length hc-highlighted-text)))) (setq hc-highlighted-text nil)) (setcar hc-stack (substring str 0 (min (length (car hc-stack)) (length str))))) (setq hc-highlighted-text nil) (setcar hc-stack str)))) (setq hc-highlighted-text nil) (setcar hc-stack str)))) (defvar hc-highlight-face (if hc-xemacs-p 'zmacs-region 'region)) (defvar hc-extent nil "In XEmacs, extent for the highlighted text. In GNU Emacs, overlay for the highlighted text.") (defun hc-highlight (start end) "Highlight text from position START to END in the current buffer." (if hc-xemacs-p (progn (setq hc-extent (make-extent start end (current-buffer))) (set-extent-face hc-extent hc-highlight-face)) (setq hc-extent (make-overlay start end)) (overlay-put hc-extent 'face hc-highlight-face))) (defun hc-unhighlight nil "Turn off highlighting, if it's on." (if hc-xemacs-p (progn (if (extent-live-p hc-extent) (delete-extent hc-extent))) (if hc-extent (delete-overlay hc-extent)))) (defun hc-pop-stack nil "Pop the stack, fixing buffer." (let ((inhibit-quit t) (old-str (cadr hc-stack)) (new-str (car hc-stack)) str) (setq str (hc-complete-stack-top nil t)) (cond ((eq str t) (setq str hc-highlighted-text) (hc-switch-stack-top old-str) (if (eq (hc-complete-stack-top nil t) t) (hc-switch-stack-top old-str (concat (substring new-str (length old-str)) str)))) ((stringp str) (hc-switch-stack-top old-str) (if (and (hc-complete-stack-top "") (null (string= old-str (hc-complete-stack-top nil t)))) (hc-switch-stack-top old-str (substring str (length old-str))))) (t (hc-switch-stack-top old-str))) (setcdr hc-stack (cddr hc-stack)))) (defun hc-complete-stack-top (more &optional no-modify char) "If possible, replace what's on top of stack, and before point, with the common completion of that extended by MORE, returning that. Return nil if no match. If result is complete and unique, return t. If optional arg NO-MODIFY is non-nil, don't modify the stack--just see if it would be complete. If optional arg CHAR is non-nil, this was called after hitting a character (which may affect the placement of the point when done)." (let* ((str (concat (car hc-stack) more)) ;; t:use real table. nil:truly no completions. alist:the completions (all (or (symbolp hc-table) (and (> (length str) 0) (= (aref str 0) ? )) (mapcar 'list (all-completions str hc-table hc-predicate)))) (try (and all (try-completion str (if (eq all t) hc-table all) (if (eq all t) hc-predicate)))) (str (if (eq try t) str try))) (and try (progn (or no-modify (hc-switch-stack-top str char)) (or (eq try t) (try-completion str (if (eq all t) hc-table all) (if (eq all t) hc-predicate))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; functions bound to keys (see also hc-quit above) ;; ;; bound to control characters (defun hc-exit-and-then nil "Intentional unsuccessful quit, then put back char to be read again." (interactive) (setq unread-command-events (list last-command-event)) (hc-quit 'keep)) (defun hc-keyboard-quit nil "Intentional unsuccessful quit, then put back char to be read again." (interactive) (setq unread-command-events (list last-command-event)) (hc-quit 'quit)) ;; bound to printing characters (defun hc-self-insert-char nil "Update hc-stack, insert this char, and run hc-complete." (interactive) (setq hc-stack (cons (concat (car hc-stack) (char-to-string last-command-char)) hc-stack)) (insert last-command-char) (hc-complete)) (defun hc-complete nil "Complete as far as possible. If no valid completions, quit. If no valid completions and the customizable variable hc-clean-up is non-nil, then delete characters until a valid string remains." (interactive) (let ((top (hc-complete-stack-top "" nil t))) (cond ((eq top t) (if (string= top (car hc-stack)) (hc-quit t))) ((null top) (hc-unhighlight) (delete-char (length hc-highlighted-text)) (setq hc-highlighted-text nil) (hc-quit 'quit))))) ;; bound to [space] (defun hc-keep-if-complete nil "Quit with success if current stack top is complete. Otherwise insert a space." (interactive) (if hc-highlighted-text (hc-complete-word) (let (top) (if (setq top (hc-complete-stack-top " " nil t)) (hc-switch-stack-top (concat (car hc-stack) " ") (substring hc-highlighted-text 1)) (setq top (hc-complete-stack-top "" nil t)) (if (eq top t) (hc-quit t) (hc-try-to-complete)))))) (defun hc-complete-word nil "Complete at most one word. After one word is completed, a space or hyphen is added, provided that matches some possible completion." (let ((old (car hc-stack)) (top (hc-complete-stack-top "" t)) (old-point (point)) diff) (if (string= old top) (hc-try-to-complete) (save-excursion (goto-char old-point) (forward-word 1) (if (looking-at hc-word-connectors) (forward-char 1)) (setq diff (- (point) old-point))) (if (and (eq top t) (<= (+ (length (concat old hc-highlighted-text)) (hc-minibuffer-prompt-width)) (+ diff old-point))) (progn (if hc-highlighted-text (forward-char (length hc-highlighted-text))) (hc-quit 'keep)) (setq top (concat old hc-highlighted-text)) (if (< diff (length hc-highlighted-text)) (hc-switch-stack-top (substring top 0 (+ (length old) diff)) (substring top (+ (length old) diff))) (hc-switch-stack-top top)))))) ;; bound to [backspace] (defun hc-delete nil "Go back one completion unit. If there is no previous unit, quit quietly." (interactive) (if (null (cdr hc-stack)) (hc-quit 'keep) (hc-pop-stack))) ;; bound to [tab] (defun hc-try-to-complete nil "Try to complete. Complete as far as possible. If there are choices, pop up buffer with list. If there are no valid completions, ding." (interactive) (let ((old (car hc-stack)) (top (hc-complete-stack-top "" t))) (cond ((string= old top) (hc-display-completions)) ((eq top t) (hc-complete-stack-top "" nil nil) (hc-quit t)) ((null top) (ding)) (t (hc-switch-stack-top top) (if (eq t (hc-complete-stack-top "" t)) (progn (hc-quit t) (hc-complete-stack-top "" nil t)) (hc-complete-stack-top "" nil t)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; stuff for completions buffer. ;; (defvar hc-completion-buffer-name " *Completions*" "Name of buffer in which to display list of completions") (defun hc-display-completions (&optional jump) "Show possible completions, just like `minibuffer-completion-help'" (interactive) (if (and (not (equal jump 'jump)) (equal hc-last-display-time (car hc-stack)) (get-buffer-window hc-completion-buffer-name)) (let ((ow (selected-window)) (w (get-buffer-window hc-completion-buffer-name))) (select-window w) (condition-case nil (if (<= (point-max) (window-end)) (goto-char (point-min)) (scroll-up)) (error (goto-char (point-min)))) (select-window ow)) (setq hc-last-display-time (car hc-stack)) (let ((all (all-completions (car hc-stack) hc-table hc-predicate)) results ans) (if (not (fboundp hc-display-filter)) nil (while all (setq ans (funcall hc-display-filter (car all))) (and ans (setq results (cons ans results))) (setq all (cdr all))) (setq all (nreverse results))) (if all (hc-display-completions-internal all))))) (defun hc-switch-to-completions () "Select the completion list window." (interactive) ;; Make sure we have a completions window. (hc-display-completions 'jump) (select-window (get-buffer-window hc-completion-buffer-name)) (goto-char (point-min)) (search-forward "\n\n") (forward-line 1)) (defun hc-choose-completion () "Choose the completion that point is in or next to. Just like choose-completion, except this calls hc-choose-completion-string instead of choose-completion-string." (interactive) (let (beg end completion (buffer completion-reference-buffer) (base-size completion-base-size)) (if (and (not (eobp)) (get-text-property (point) 'mouse-face)) (setq end (point) beg (1+ (point)))) (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face)) (setq end (1- (point)) beg (point))) (if (null beg) (error "No completion here")) (setq beg (previous-single-property-change beg 'mouse-face)) (setq end (or (next-single-property-change end 'mouse-face) (point-max))) (setq completion (buffer-substring-no-properties beg end)) (let ((owindow (selected-window))) (if (and (one-window-p t 'selected-frame) (window-dedicated-p (selected-window))) ;; This is a special buffer's frame (iconify-frame (selected-frame)) (or (window-dedicated-p (selected-window)) (bury-buffer))) (select-window owindow)) (hc-choose-completion-string completion buffer base-size))) (defun hc-mouse-choose-completion (event) "Click on an alternative in the `*Completions*' buffer to choose it. Just like mouse-choose-completion, except this calls hc-choose-completion-string instead of choose-completion-string." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (let ((buffer (window-buffer)) choice base-size) (save-excursion (set-buffer (window-buffer (posn-window (event-start event)))) (if completion-reference-buffer (setq buffer completion-reference-buffer)) (setq base-size completion-base-size) (save-excursion (goto-char (posn-point (event-start event))) (let (beg end) (if (and (not (eobp)) (get-text-property (point) 'mouse-face)) (setq end (point) beg (1+ (point)))) (if (null beg) (error "No completion here")) (setq beg (previous-single-property-change beg 'mouse-face)) (setq end (or (next-single-property-change end 'mouse-face) (point-max))) (setq choice (buffer-substring-no-properties beg end))))) (let ((owindow (selected-window))) (select-window (posn-window (event-start event))) (if (and (one-window-p t 'selected-frame) (window-dedicated-p (selected-window))) ;; This is a special buffer's frame (iconify-frame (selected-frame)) (or (window-dedicated-p (selected-window)) (bury-buffer))) (select-window owindow)) (hc-choose-completion-string choice buffer base-size))) (defun hc-choose-completion-string (choice &optional buffer base-size) "Like choose-completion-string (from simple.el), with some stuff to make it work well (it says here) with highlighting completion." (let ((buffer (or buffer completion-reference-buffer))) ;; If BUFFER is a minibuffer, barf unless it's the currently ;; active minibuffer. (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer)) (or (not (active-minibuffer-window)) (not (equal buffer (window-buffer (active-minibuffer-window)))))) (error "Minibuffer is not active for completion") ;; Insert the completion into the buffer where completion was requested. (set-buffer buffer) (if base-size (delete-region (+ base-size (point-min)) (point)) (choose-completion-delete-max-match choice)) (insert choice) ; (remove-text-properties (- (point) (length choice)) (point) ; '(mouse-face nil)) (if (string-match (regexp-quote (car hc-stack)) choice) (setq hc-stack (cons choice hc-stack)) (setq hc-stack (cons (concat (car hc-stack) choice) hc-stack))) ;; choice may be part of a multiline string (e.g. in ultra-tex), ;; so complete (if (hc-complete-stack-top "" t) (hc-complete-stack-top "")) ;; Update point in the window that BUFFER is showing in. (let ((window (get-buffer-window buffer t))) (set-window-point window (point))) ;; If completing for the minibuffer, exit it with this choice. (if (and (equal buffer (window-buffer (minibuffer-window))) minibuffer-completion-table) ;; If this is reading a file name, and the file name chosen ;; is a directory, don't exit the minibuffer. (if (and (eq minibuffer-completion-table 'read-file-name-internal) (file-directory-p (buffer-string))) (select-window (active-minibuffer-window)) (exit-minibuffer)) (and hc-prev-windows (hc-quit 'choose)))))) (defvar hc-completion-fixup-function nil "A function to customize how completions are identified in completion lists. `hc-completion-setup-function' calls this function with no arguments each time it has found what it thinks is one completion. Point is at the end of the completion in the completion list buffer. If this function moves point, it can alter the end of that completion.") (defvar hc-completion-message-function 'hc-completion-default-message-function "A function to give the text at the top of the *Completions* buffer. Called by `hc-completion-setup-function'.") (defun hc-completion-default-message-function nil "Standard message function for hc-completion-setup-function." (if (hc-window-system) (insert (substitute-command-keys "Click \\[hc-mouse-choose-completion] on a completion to select it.\n"))) (insert (substitute-command-keys "In this buffer, type \\[hc-choose-completion] to \ select the completion near point.\n\n")) (forward-line 1)) (defun hc-completion-setup-function () "Like completion-setup-function (from simple.el), except with slightly different messages." (save-excursion (let ((mainbuf (current-buffer))) (set-buffer standard-output) (completion-list-mode) (make-local-variable 'completion-reference-buffer) (setq completion-reference-buffer mainbuf) ;; The value 0 is right in most cases, but not for file name completion. ;; so this has to be turned off. ;; (setq completion-base-size 0) (goto-char (point-min)) (if hc-completion-message-function (funcall hc-completion-message-function)) (while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t) (let ((beg (match-beginning 0)) (end (point))) (if hc-completion-fixup-function (funcall hc-completion-fixup-function)) (put-text-property beg (point) 'mouse-face 'highlight) (goto-char end)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; utilities ;; (defun word-grabber nil "Move point to just after the word point is in or after, and return length of word." (skip-chars-forward "^ \n\t\f\"`'();{}") (- (point) (save-excursion (skip-chars-backward "^ \n\t\f\"`'();{}") (point)))) (defun point-adjust-hook (arg) "Intended to be used when hc-table is an alist whose elements look like `( . )'. Move point forward chars, and then run (if non-nil)." (forward-char (car (cdr arg))) (if (cdr (cdr arg)) (funcall (cdr (cdr arg))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; entry points for completion on various things. see also ;; hc-complete-buffer-contents below. ;; (defun hc-complete-lisp-object nil "Complete lisp object in buffer at point." (interactive) (hc-completing-insert obarray nil (word-grabber) nil "lisp objects")) (defun hc-complete-lisp-function nil "Complete lisp object in buffer at point." (interactive) (hc-completing-insert obarray 'fboundp (word-grabber) nil "functions")) (defun hc-complete-lisp-variable nil "Complete lisp object in buffer at point." (interactive) (hc-completing-insert obarray 'boundp (word-grabber) nil "variables")) (defun hc-complete-buffer-name nil "Complete buffer name in buffer at point." (interactive) (hc-completing-insert (mapcar (function (lambda (x) (list (buffer-name x)))) (buffer-list)) nil (word-grabber) nil "buffer names")) (defun hc-complete-kill-ring nil "Complete something from the kill ring in buffer at point." (interactive) (hc-completing-insert (mapcar 'list (apply 'append (mapcar (function (lambda (x) (cons x (and (string-match "\\s-+" x) (list (substring x (match-end 0))))))) kill-ring))) nil 0 nil "recent kills")) (defun hc-complete-word nil "Complete the current word using ispell." (interactive) (hc-completing-insert 'hc-lookup-words nil (word-grabber) nil "words")) (defun hc-lookup-words (string pred flag) "Complete STRING a la ispell-complete-word. PRED will always be nil--it's there for compatibility purposes. If FLAG is non-nil, return all possible completions. If FLAG is nil, complete as far as possible. If there is a unique completion, return it. If STRING equals the unique completion, return t." (require 'ispell) (let ((word-list (lookup-words string)) (guess string)) (if flag word-list (if (zerop (length word-list)) nil (if (= 1 (length word-list)) (or (string= string (car word-list)) (car word-list)) (while (and (not (string= guess (car word-list))) (not (member nil (mapcar (function (lambda (word) (string-match (regexp-quote (substring (car word-list) 0 (1+ (length guess)))) word))) word-list)))) (setq guess (substring (car word-list) 0 (1+ (length guess))))) guess))))) (defalias 'hc-completing-insert-lisp-object 'hc-complete-lisp-object) (defalias 'hc-completing-insert-lisp-function 'hc-complete-lisp-function) (defalias 'hc-completing-insert-lisp-variable 'hc-complete-lisp-variable) (defalias 'hc-completing-insert-buffer-name 'hc-complete-buffer-name) (defalias 'hc-completing-insert-kill 'hc-complete-kill-ring) (defalias 'hc-completing-insert-file-name 'hc-complete-file-name) (defalias 'hc-completing-insert-buffer-contents 'hc-complete-buffer-contents) (defalias 'hc-ispell-complete-word 'hc-complete-word) (defalias 'hc-completing-insert-according-to-mode 'hc-complete-a-la-mode) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; completion a la mode ;; (defun hc-complete-a-la-mode nil "Start highlighting completion. If possible, resumes stopped completion. Otherwise, in the minibuffer, uses its table and predicate (slightly modified for file name reading). Failing that, calls `hc-default-completion-function' if the mode has it set. Final default is lisp-object completion." (interactive) (cond ((hc-completing-insert hc-table hc-predicate -1 hc-hook) nil) ((and (minibuffer-window-active-p (minibuffer-window)) minibuffer-completion-table) (let* ((table (if (eq minibuffer-completion-table 'read-file-name-internal) 'hc-read-file-name-internal minibuffer-completion-table)) (message (cond ((eq table 'hc-read-file-name-internal) "file names") ((and (listp table) (bufferp (cdr (car table)))) "buffers") ((eq obarray table) (cond ((not (and (boundp 'minibuffer-completion-predicate) minibuffer-completion-predicate)) "lisp objects") ((eq 'fboundp minibuffer-completion-predicate) "functions") ((eq 'commandp minibuffer-completion-predicate) "commands") ((eq 'boundp minibuffer-completion-predicate) "variables") ((eq 'user-variable-p minibuffer-completion-predicate) "user variables"))) (t "something"))) (display (and (eq table 'hc-read-file-name-internal) 'hc-file-display-filter))) (or (hc-completing-insert table minibuffer-completion-predicate -1) (hc-completing-insert table minibuffer-completion-predicate (progn (goto-char (point-max)) (- (point) (point-min))) nil message display)))) ;; I moved this here to make existing minibuffer ;; completion info take precedence over stopped completion. ;; -- Nick Reingold 5/24/92 ((hc-completing-insert hc-table hc-predicate -1 hc-hook hc-display-filter) nil) (hc-default-completion-function (call-interactively hc-default-completion-function)) (t (hc-complete-lisp-object)))) (defvar hc-default-completion-function nil "Function to be called by M-x hc-complete-a-la-mode, if non-nil") (make-variable-buffer-local 'hc-default-completion-function) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; turning on highlighting ;; ;; Customize the variable highlight-completion-mode, to turn on ;; highlighting completion. (defun highlight-completion-setup () (interactive) (let ((pred minibuffer-completion-predicate) complete-p message table display) (cond ((eq minibuffer-history-variable 'file-name-history) (setq complete-p (hc-complete-p 'files) message "file names" table 'hc-read-file-name-internal pred (hc-expand-file-name pred) display 'hc-file-display-filter)) ((eq 'fboundp minibuffer-completion-predicate) (setq complete-p (hc-complete-p 'functions) message "functions" table obarray)) ((eq 'commandp minibuffer-completion-predicate) (setq complete-p (hc-complete-p 'commands) message "commands" table obarray)) ((eq 'boundp minibuffer-completion-predicate) (setq complete-p (hc-complete-p 'variables) message "variables" table obarray)) ((eq 'user-variable-p minibuffer-completion-predicate) (setq complete-p (hc-complete-p 'user-variables) message "user variables" table obarray)) ((and (eq minibuffer-completion-table obarray) (not (and (boundp 'minibuffer-completion-predicate) minibuffer-completion-predicate))) (setq complete-p (hc-complete-p 'lisp-objects) message "lisp objects" table obarray)) ((eq 'Info-complete-menu-item minibuffer-completion-table) (setq complete-p (hc-complete-p 'info-menu-items) message "Info menu items" table minibuffer-completion-table)) ((eq minibuffer-history-variable 'query-replace-history) (setq complete-p (hc-complete-p 'query) message "buffer contents" table 'hc-buffer-completion-internal pred (car (cdr (buffer-list))))) ((and (listp minibuffer-completion-table) (listp (car minibuffer-completion-table)) (bufferp (cdr (car minibuffer-completion-table)))) (setq complete-p (hc-complete-p 'buffers) message "buffers" table minibuffer-completion-table)) (minibuffer-completion-table (setq complete-p (hc-complete-p 'misc) message "something" table minibuffer-completion-table))) (if (and highlight-completion-mode complete-p) (progn (or (hc-completing-insert table pred -1) (hc-completing-insert table pred (progn (goto-char (point-max)) (- (point) (point-min) (hc-minibuffer-prompt-width))) nil message display)))))) (defun query-replace-read-args (string regexp-flag) (hc-query-replace-read-args string regexp-flag)) (defun hc-query-replace-read-args (string regexp-flag) (let (from to) (if query-replace-interactive (setq from (car (if regexp-flag regexp-search-ring search-ring))) (setq from (read-from-minibuffer (format "%s: " string) nil nil nil 'query-replace-history))) (remove-hook 'minibuffer-setup-hook 'highlight-completion-setup) (condition-case () (setq to (read-from-minibuffer (format "%s %s with: " string from) nil nil nil 'query-replace-history)) (quit (add-hook 'minibuffer-setup-hook 'highlight-completion-setup) (error "Quit"))) (add-hook 'minibuffer-setup-hook 'highlight-completion-setup) (list from to current-prefix-arg))) (defun hc-complete-p (arg) "Non-nil if one should do highlighting completion in environment ARG, as determined by the value of the variable highlight-completion-list." (cdr (assoc arg highlight-completion-list))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; file completion stuff ;; (defun hc-complete-file-name (&optional dir init) "Complete file name in buffer at point. Non-interactively, use directory DIR (nil for current default-directory); start with INIT chars before point." (interactive (list nil (word-grabber))) (hc-completing-insert 'hc-read-file-name-internal (or dir default-directory) (or init 0) nil "file names" 'hc-file-display-filter)) (defconst hc-literal-file-regexp "\\(\\(^\\|/\\)\\(~[^/]*\\|\\.\\.?\\)\\|\\${?[a-zA-Z0-9]*\\)$" "Regexp for file names which don't get completed, yet.") (defconst hc-expand-this-file-regexp "\\(\\${[a-zA-Z0-9]*}\\|\\(^\\|/\\)\\.\\.?/\\)$" "Regexp for file names which get expanded before completion.") (defun hc-read-file-name-internal (str dir action) "\"Internal\" subroutine for `hc-complete-file-name'. Do not call this." (let (str-dir real-str) (cond ((and (null action) (string-match hc-literal-file-regexp str)) str) ((progn (setq real-str (hc-expand-file-name (substitute-in-file-name str) dir) str-dir (file-name-directory real-str)) (not (file-directory-p str-dir))) nil) ((eq action t) (mapcar (function (lambda (x) (expand-file-name x str-dir))) (read-file-name-internal str dir action))) ((file-directory-p real-str) real-str) (t (let* ((exp (string-match hc-expand-this-file-regexp str)) (str (if exp real-str str)) (ans (read-file-name-internal str dir action))) (if (null action) (if (and exp (eq ans t)) str ans) (and (not exp) ans))))))) (defun hc-expand-file-name (name &optional dir) "Like expand-file-name, except that if first arg NAME is something like `bozo/.' then return `bozo/'. expand-file-name, in contrast, would return `bozo'." (concat (expand-file-name name dir) (if (or (and (< 1 (length name)) (string= "/." (substring name -2))) (and (< 2 (length name)) (string= "/.." (substring name -3)))) "/"))) (defun hc-file-display-filter (fn) (cond ((string-match hc-ignored-file-extensions fn) nil) ((file-directory-p fn) (let ((dir (if (file-directory-p (car hc-stack)) (car hc-stack) (directory-file-name (car hc-stack))))) (if (string= fn (hc-expand-file-name "./" dir)) "./" (if (string= fn (hc-expand-file-name "../" dir)) "../" (concat (file-name-nondirectory (directory-file-name fn)) "/"))))) (t (file-name-nondirectory fn)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; buffer completion stuff. ;; ;; This section adapts highlighting completion to complete on ;; reasonably balanced substrings of a buffer. The main entry point ;; is ;; (hc-complete-buffer-contents BUF) ;; where BUF is interactively the current buffer or, with arg, a buffer ;; specified by the user. (defun hc-buffer-sub-hunk (start end) "Return substring of current buffer from START at least up to END, extended sufficiently to be balanced if possible, but in any case not to include more than one non-blank line past END." (save-excursion (goto-char end) (skip-chars-forward "\n") (skip-chars-forward "^\n") (save-restriction (narrow-to-region start (point)) (goto-char start) (let (n) (while (< (point) end) (condition-case what (goto-char (setq n (scan-sexps (point) 1))) (error (if (or (null n) (= ?U (aref (car (cdr what)) 0))) (goto-char (point-max)) (forward-char 1)))))) (buffer-substring-no-properties start (point))))) (defvar hc-buf-comp-internal-last nil) ; last return of a try-type call (defun hc-buffer-completion-internal (str buf action) "Internal subroutine for `hc-complete-buffer-contents'. Do not call this. Used like `read-file-name-internal' but for completing STR as a substring of buffer BUF. Completing with space as last char matches anything, as long as the match is unique. ACTION nil means common part of proper extensions of STR, up to next sexp boundary, t means list of some of these extensions. Other means return nil (no substring is ever considered complete)." (and (memq action '(nil t)) ; never complete so keep is disabled (save-window-excursion (let* ((obuf (prog1 (current-buffer) (set-buffer buf))) inhibit-quit case-fold-search find (l (length str))) (prog2 (if (eq buf obuf) ; hide completion in progress (progn (setq inhibit-quit t) (delete-backward-char (length (car hc-stack))))) (if action (let ((oball (make-vector 37 0)) (n 700)) (save-excursion (goto-char (point-min)) (while (and (< 0 (setq n (1- n))) (search-forward str nil t)) (intern (hc-buffer-sub-hunk (match-beginning 0) (min (point-max) (1+ (point)))) oball)) (if (< 0 n) (all-completions "" oball) '("Completions too numerous to mention!")))) (setq ; this arranges that identical repeats hc-buf-comp-internal-last ; of a try call do no work, speeding (if (eq str hc-buf-comp-internal-last) str ; up hc-complete-stack-top. (save-excursion (goto-char (point-min)) (or (and (search-forward str nil t) (setq find (hc-buffer-sub-hunk (match-beginning 0) (point))) (progn (while (and (> (length find) l) (search-forward str nil t)) (setq find (try-completion "" (list (list find) (list (buffer-substring-no-properties (match-beginning 0) (min (point-max) (+ (match-beginning 0) (length find))))))))) find)) (and (string-match "\\s-" (substring str -1)) (search-forward (setq str (substring str 0 -1)) nil t) (setq find (hc-buffer-sub-hunk (match-beginning 0) (min (point-max) (1+ (point))))) (progn (setq l (1- l)) (while (and (> (length find) l) (search-forward str nil t)) (setq find (try-completion "" (list (list find) (list (buffer-substring-no-properties (match-beginning 0) (min (point-max) (+ (match-beginning 0) (length find))))))))) (and (> (length find) l) find)))))))) ;; unhide: (if (eq buf obuf) (insert (car hc-stack)))))))) (defun hc-complete-buffer-contents (&optional buf) "Complete on substrings of BUF extending to sexp boundaries. String is never complete, so exit with C-c. Once unique, space means match more. Interactively, with arg, ask for the buffer, else current buffer." (interactive "P") (if (and (interactive-p) buf) (setq buf (read-buffer "Complete from buffer: "))) (setq buf (or buf (current-buffer))) (hc-completing-insert 'hc-buffer-completion-internal buf 0 nil "buffer contents")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions that depend on the version of Emacs. ;; (defun hc-character-to-event (char) "Convert a character CHAR into an event. This just returns CHAR in GNU Emacs 19 or 20. In XEmacs, it calls character-to-event." (if (fboundp 'character-to-event) (character-to-event char) char)) (defun hc-window-system () "Non-nil if using x windows" (if (fboundp 'console-type) (eq (console-type) 'x) (eq window-system 'x))) (defun hc-minibuffer-prompt-width () "0 unless using GNU Emacs 21, in which case minibuffer-prompt-width" (if hc-emacs-21-p (minibuffer-prompt-width) 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; More stuff dependent on the version of emacs. This is all related ;; to displaying completions. ;; (defvar hc-completion-default-help-string '(concat (if (device-on-window-system-p) (substitute-command-keys "Click \\\\[hc-mouse-choose-completion] on a completion to select it.\n") "") (substitute-command-keys "Type \\\\[hc-advertised-switch-to-completions] or \\\\[hc-advertised-switch-to-completions] to move to this buffer, for keyboard selection.\n In this buffer, type \\\\[hc-choose-completion] to select the completion near point.\n\n")) "For use with XEmacs only. Form the evaluate to get a help string for completion lists. This string is inserted at the beginning of the buffer. See `display-completion-list'.") (defun hc-display-completions-internal (all) "Run display-completion-list with appropriate modifications, depending on whether we're using XEmacs or not." (if hc-xemacs-p (with-output-to-temp-buffer hc-completion-buffer-name (display-completion-list (sort all 'string<) :help-string hc-completion-default-help-string)) (let ((old-hook completion-setup-hook) (old-map completion-list-mode-map)) (setq completion-setup-hook 'hc-completion-setup-function completion-list-mode-map hc-completion-list-mode-map) (with-output-to-temp-buffer hc-completion-buffer-name (display-completion-list (sort all 'string<))) (setq completion-setup-hook old-hook completion-list-mode-map old-map)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (provide 'highlight-completion) ;;; highlight-completion.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/auto-fill-inhibit.el0000775000000000000000000000610512230377265023112 0ustar ;;; auto-fill-mode-inhibit -- finer grained control over ;;; auto-fill-mode (de)activation ;;; Copyright (c) 2003 Michael Weber ;; ;;; Version: 20030509 ;; ;;; License: ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License ;; version 2 as published by the Free Software Foundation. ;; ;; 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, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA ;; 02111-1307 USA ;; ;; NO-VIRUS CLAUSE: ;; The intent of this license is to protect free redistribution and ;; reuse of the source of the licensed distribution, not to prejudice ;; the authorship rights of programmers of other code to control ;; their original inventions. ;; ;; No portion of this license is to be interpreted as forbidding the ;; reuse of this code or its constituent parts, algorithms, or ;; inventions in commercial products. ;; ;; Nor shall such inclusion be construed to require the GPLing or ;; disclosure of any portions of said commercial products other than ;; those falling under the copyright of the licensed distribution. ;; ;;; Commentary: ;; ;; To activate auto-fill-mode, add the following line to your Emacs ;; initialization: ;; (add-hook 'text-mode-hook 'turn-on-auto-fill) ;;; History: ;; ;; 20030509: ;; * activate advice through `defadvice' instead of call to ;; `ad-activate' ;; * emit message if `auto-fill-mode' gets inhibited ;; * add (provide) line ;; * make `auto-fill-inhibit-list' a `defcustom' ;; * fixed docstrings to make M-x checkdoc happy ;; (thanks to psg@debian.org for hints) ;; ;; 20011114: ;; * Initial Version ;;; Code: (defcustom auto-fill-inhibit-list nil "regexep LIST to match against buffer-name to inhibit auto-fill-mode. An empty list of regexps (the default) retains the original `auto-fill-mode' behaviour." :require 'auto-fill-inhibit :type '(repeat (regexp :tag "Buffer name regexp"))) (defadvice auto-fill-mode (before auto-fill-mode-inhibit activate) "Turn off `auto-fill-mode' on matching buffers. Buffers which have their names `string-match' on any one regexp in `auto-fill-inhibit-list'. Unless something is put into this variable, it behaves transparently to default auto-fill functionality." (let ((bufname (buffer-name))) (if (catch 'match (mapcar (function (lambda (s) (if (string-match s bufname) (throw 'match t)))) auto-fill-inhibit-list) nil) (progn (message "auto-fill-mode inhibited for this buffer through auto-fill-inhibit-list") ;;; turn off auto-fill-mode (setting arg0 to `0') (ad-set-arg 0 0))))) (provide 'auto-fill-inhibit) ;;; auto-fill-inhibit.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/bar-cursor.el0000775000000000000000000001543212230377266021655 0ustar ;;; @(#) bar-cursor.el -- package used to switch block cursor to a bar ;;; @(#) $Id: bar-cursor.el,v 1.1 2003-04-04 20:15:55 lolando Exp $ ;; This file is not part of Emacs ;; Copyright (C) 2001 by Joseph L. Casadonte Jr. ;; Author: Joe Casadonte (emacs@northbound-train.com) ;; Maintainer: Joe Casadonte (emacs@northbound-train.com) ;; Created: July 1, 2001 ;; Keywords: bar cursor overwrite ;; Latest Version: http://www.northbound-train.com/emacs.html ;; COPYRIGHT NOTICE ;; 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 2, 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; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; ;; Simple package to convert the block cursor into a bar cursor. In ;; overwrite mode, the bar cursor changes back into a block cursor. ;; This is a quasi-minor mode, meaning that it can be turned on & off ;; easily though only globally (hence the quasi-) ;;; Installation: ;; ;; Put this file on your Emacs-Lisp load path and add the following to ;; your ~/.emacs startup file ;; ;; (require 'bar-cursor) ;; (bar-cursor-mode 1) ;; ;; To add a directory to your load-path, use something like the following: ;; ;; (add-to-list 'load-path (expand-file-name "/some/load/path")) ;;; Usage: ;; ;; M-x `bar-cursor-mode' ;; Toggles bar-cursor-mode on & off. Optional arg turns ;; bar-cursor-mode on iff arg is a positive integer. ;;; To Do: ;; ;; o Nothing, at the moment. ;;; Credits: ;; ;; The basis for this code comes from Steve Kemp by way of the ;; NTEmacs mailing list. ;;; Comments: ;; ;; Any comments, suggestions, bug reports or upgrade requests are welcome. ;; Please send them to Joe Casadonte (emacs@northbound-train.com). ;; ;; This version of bar-cursor was developed and tested with NTEmacs ;; 20.7.1 under Windows 2000 & NT 4.0 and Emacs 20.7.1 under Linux ;; (RH7). Please, let me know if it works with other OS and versions ;; of Emacs. ;;; Change Log: ;; ;; see http://www.northbound-train.com/emacs/bar-cursor.log ;;; ************************************************************************** ;;; ************************************************************************** ;;; ************************************************************************** ;;; ************************************************************************** ;;; ************************************************************************** ;;; Code: (eval-when-compile ;; silence the old byte-compiler (defvar byte-compile-dynamic nil) (set (make-local-variable 'byte-compile-dynamic) t)) ;;; ************************************************************************** ;;; ***** version related routines ;;; ************************************************************************** (defconst bar-cursor-version "$Revision: 1.1 $" "Version number for 'bar-cursor' package.") ;; --------------------------------------------------------------------------- (defun bar-cursor-version-number () "Return 'bar-cursor' version number." (string-match "[0123456789.]+" bar-cursor-version) (match-string 0 bar-cursor-version)) ;; --------------------------------------------------------------------------- (defun bar-cursor-display-version () "Display 'bar-cursor' version." (interactive) (message "bar-cursor version <%s>." (bar-cursor-version-number))) ;;; ************************************************************************** ;;; ***** real functions ;;; ************************************************************************** (defvar bar-cursor-mode nil "Non-nil if 'bar-cursor-mode' is enabled.") ;;; -------------------------------------------------------------------------- ;;;###autoload (defun bar-cursor-mode (&optional arg) "Toggle use of 'bar-cursor-mode'. This quasi-minor mode changes cursor to a bar cursor in insert mode, and a block cursor in overwrite mode. It may only be turned on and off globally, not on a per-buffer basis (hence the quasi- designation). Optional ARG turns mode on iff ARG is a positive integer." (interactive "P") ;; toggle on and off (let ((old-mode bar-cursor-mode)) (setq bar-cursor-mode (if arg (or (listp arg) (> (prefix-numeric-value arg) 0)) (not bar-cursor-mode))) (when (not (equal old-mode bar-cursor-mode)) ;; enable/disable advice (if bar-cursor-mode (ad-enable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad) (ad-disable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad)) (ad-activate 'overwrite-mode) ;; set the initial cursor type now (bar-cursor-set-cursor) ;; add or remove to frame hook (if bar-cursor-mode (add-hook 'after-make-frame-functions 'bar-cursor-set-cursor) (remove-hook 'after-make-frame-functions 'bar-cursor-set-cursor)) ))) ;;;-------------------------------------------------------------------------- (defadvice overwrite-mode (after bar-cursor-overwrite-mode-ad disable) "Advice that controls what type of cursor is displayed." (bar-cursor-set-cursor)) ;;;-------------------------------------------------------------------------- (defun bar-cursor-set-cursor-type (cursor &optional frame) "Set the cursor-type for the named frame. CURSOR is the name of the cursor to use (bar or block -- any others?). FRAME is optional frame to set the cursor for; current frame is used if not passed in." (interactive) (if (not frame) (setq frame (selected-frame))) ;; Do the modification. (modify-frame-parameters frame (list (cons 'cursor-type cursor)))) ;;; -------------------------------------------------------------------------- (defun bar-cursor-set-cursor (&optional frame) "Set the cursor-type according to the insertion mode. FRAME is optional frame to set the cursor for; current frame is used if not passed in." (if (and bar-cursor-mode (not overwrite-mode)) (bar-cursor-set-cursor-type 'bar frame) (bar-cursor-set-cursor-type 'block frame))) ;;; ************************************************************************** ;;; ***** we're done ;;; ************************************************************************** (provide 'bar-cursor) ;;; bar-cursor.el ends here ;;; ************************************************************************** ;;;; ***** EOF ***** EOF ***** EOF ***** EOF ***** EOF ************* emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/matlab.el0000664000000000000000000064510612230377266021042 0ustar ;;; matlab.el --- major mode for MATLAB(R) dot-m files ;; ;; Author: Matt Wette , ;; Eric M. Ludlam ;; Maintainer: Eric M. Ludlam ;; Created: 04 Jan 91 ;; Keywords: MATLAB(R) ;; Version: (defconst matlab-mode-version "3.3.2" "Current version of MATLAB(R) mode.") ;; ;; Copyright (C) 2004-2010 The Mathworks, Inc ;; Copyright (C) 1997-2004 Eric M. Ludlam: The MathWorks, Inc ;; Copyright (C) 1991-1997 Matthew R. Wette ;; ;; 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 2, 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 GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; ;;; Commentary: ;; ;; This major mode for GNU Emacs provides support for editing MATLAB(R) dot-m ;; files. It automatically indents for block structures (including nested ;; functions), line continuations (e.g., ...), and comments. ;; ;; Additional features include auto-fill including auto-additions of ;; ellipsis for commands, and even strings. Block/end construct ;; highlighting as you edit. Primitive code-verification and ;; identification. Templates and other code editing functions. ;; Advanced symbol completion. Code highlighting via font-lock. ;; There are many navigation commands that let you move across blocks ;; of code at different levels. ;; ;; Lastly, there is support for running MATLAB(R) in an Emacs buffer, ;; with full shell history and debugger support (when used with the db ;; commands.) The shell can be used as an online help while editing ;; code, providing help on functions, variables, or running arbitrary ;; blocks of code from the buffer you are editing. ;;; Code: (require 'easymenu) (require 'tempo) (require 'derived) ;; compatibility (if (string-match "X[Ee]macs" emacs-version) (progn (defalias 'matlab-make-overlay 'make-extent) (defalias 'matlab-overlay-put 'set-extent-property) (defalias 'matlab-overlay-get 'extent-property) (defalias 'matlab-delete-overlay 'delete-extent) (defalias 'matlab-overlay-start 'extent-start-position) (defalias 'matlab-overlay-end 'extent-end-position) (defalias 'matlab-previous-overlay-change 'previous-extent-change) (defalias 'matlab-next-overlay-change 'next-extent-change) (defalias 'matlab-overlays-at (lambda (pos) (extent-list nil pos pos))) (defalias 'matlab-cancel-timer 'delete-itimer) (defun matlab-run-with-idle-timer (secs repeat function &rest args) (condition-case nil (apply 'start-itimer "matlab" function secs (if repeat secs nil) t t (car args)) (error ;; If the above doesn't work, then try this old version of ;; start itimer. (start-itimer "matlab" function secs (if repeat secs nil))))) ) (defalias 'matlab-make-overlay 'make-overlay) (defalias 'matlab-overlay-put 'overlay-put) (defalias 'matlab-overlay-get 'overlay-get) (defalias 'matlab-delete-overlay 'delete-overlay) (defalias 'matlab-overlay-start 'overlay-start) (defalias 'matlab-overlay-end 'overlay-end) (defalias 'matlab-previous-overlay-change 'previous-overlay-change) (defalias 'matlab-next-overlay-change 'next-overlay-change) (defalias 'matlab-overlays-at 'overlays-at) (defalias 'matlab-cancel-timer 'cancel-timer) (defalias 'matlab-run-with-idle-timer 'run-with-idle-timer) ) (cond ((fboundp 'point-at-bol) (defalias 'matlab-point-at-bol 'point-at-bol) (defalias 'matlab-point-at-eol 'point-at-eol)) ;; Emacs 20.4 ((fboundp 'line-beginning-position) (defalias 'matlab-point-at-bol 'line-beginning-position) (defalias 'matlab-point-at-eol 'line-end-position)) (t (defmacro matlab-point-at-bol () (save-excursion (beginning-of-line) (point))) (defmacro matlab-point-at-eol () (save-excursion (end-of-line) (point))))) (defmacro matlab-run-in-matlab-mode-only (&rest body) "Execute BODY only if the active buffer is a MATLAB(R) M-file buffer." `(if (eq major-mode 'matlab-mode) (progn ,@body) (error "This command works only in a MATLAB M-file buffer"))) (defun matlab-with-emacs-link () "Return non-nil if Emacs Link is running and user wants to use it." (and (featurep 'matlab-eei) matlab-use-eei matlab-eei-process)) ;;; User-changeable variables ================================================= ;; Variables which the user can change (defgroup matlab nil "MATLAB(R) mode." :prefix "matlab-" :group 'languages) (defcustom matlab-indent-level 4 "*The basic indentation amount in `matlab-mode'." :group 'matlab :type 'integer) (defcustom matlab-cont-level 4 "*Basic indentation after continuation if no other methods are found." :group 'matlab :type 'integer) (defcustom matlab-cont-requires-ellipsis t "*Specify if ellipses are required at the end of a line for continuation. Future versions of Matlab may not require ellipses ... , so a heuristic determining if there is to be continuation is used instead." :group 'matlab :type 'integer) (defcustom matlab-case-level '(2 . 2) "*How far to indent case/otherwise statements in a switch. This can be an integer, which is the distance to indent the CASE and OTHERWISE commands, and how far to indent commands appearing in CASE and OTHERWISE blocks. It can also be a cons cell which is of form (CASEINDENT . COMMANDINDENT) where CASEINDENT is the indentation of the CASE and OTHERWISE statements, and COMMANDINDENT is the indentation of commands appearing after the CASE or OTHERWISE command. Note: Currently a bug exists if: CASEINDENT+COMMANDINDENT != `matlab-indent-level' so if you customize these variables, follow the above rule, and you should be ok." :group 'matlab :type 'sexp) (defcustom matlab-indent-function-body 'guess "*If non-nil, indent body of function. If the global value is nil, do not indent function bodies. If the global value is t, always indent function bodies. If the global value is 'guess, then the local value will be set to either nil or t when the MATLAB mode is started in a buffer based on the file's current indentation. If the global value is 'MathWorks-Standard, then the local value is not changed, and functions are indented based on `matlab-functions-have-end'." :group 'matlab :type '(choice (const :tag "Always" t) (const :tag "Never" nil) (const :tag "Guess" 'guess) (const :tag "MathWorks Standard" 'MathWorks-Standard)) ) (make-variable-buffer-local 'matlab-indent-function-body) (defcustom matlab-functions-have-end nil "*If non-nil, functions-have-end minor mode is on by default." :group 'matlab :type 'boolean) (make-variable-buffer-local 'matlab-functions-have-end) (defun matlab-toggle-functions-have-end () (interactive) (matlab-toggle-functions-have-end-minor-mode)) ;; The following minor mode is on if and only if the above variable is true; (easy-mmode-define-minor-mode matlab-functions-have-end-minor-mode "Toggle functions-have-end minor mode, indicating function/end pairing." nil (condition-case nil ;; avoid parse error on xemacs (eval (read "#(\" function...end\" 0 15 (face (font-lock-keyword-face) fontified t))")) (error " function...end")) nil ; empty mode-map ;; body of matlab-functions-have-end-minor-mode (if matlab-functions-have-end-minor-mode (setq matlab-functions-have-end t) (setq matlab-functions-have-end nil) ) ) (defun matlab-do-functions-have-end-p () "Non-nil if the first function in the current buffer terminates with end." (save-excursion (goto-char (point-min)) (if (re-search-forward matlab-defun-regex nil t) (let ((matlab-functions-have-end t)) (beginning-of-line) (condition-case nil (progn (matlab-forward-sexp) t) (error nil)) ) nil ) )) (defun matlab-toggle-functions-have-end-minor-mode () (matlab-functions-have-end-minor-mode) (if (and matlab-functions-have-end-minor-mode (not (eq major-mode 'matlab-mode))) (progn (matlab-functions-have-end-minor-mode -1) (error "functions-have-end minor mode is only for MATLAB Major mode"))) (setq matlab-functions-have-end matlab-functions-have-end-minor-mode)) (defun matlab-indent-function-body-p () "Non-nil if functions bodies are indented. See `matlab-indent-function-body' variable." (if (eq matlab-indent-function-body 'MathWorks-Standard) ;; Dec '09 ;; The MathWorks standard is the same as if functions have end. matlab-functions-have-end ;; Else, just return the variable. matlab-indent-function-body)) (defcustom matlab-indent-past-arg1-functions "[sg]et\\(_param\\)?\\|waitfor" "*Regex describing functions whose first arg is special. This specialness means that all following parameters which appear on continued lines should appear indented to line up with the second argument, not the first argument." :group 'matlab :type 'string) (defcustom matlab-arg1-max-indent-length 15 "*The maximum length to indent when indenting past arg1. If arg1 is exceptionally long, then only this number of characters will be indented beyond the open paren starting the parameter list.") (defcustom matlab-maximum-indents '(;; = is a convenience. Don't go too far (?= . (10 . 4)) ;; Fns should provide hard limits (?\( . 50) ;; Matrix/Cell arrays (?\[ . 20) (?\{ . 20)) "Alist of maximum indentations when lining up code. Each element is of the form (CHAR . INDENT) where char is a character the indent engine is using, and INDENT is the maximum indentation allowed. Indent could be of the form (MAXIMUM . INDENT), where MAXIMUM is the maximum allowed calculated indent, and INDENT is the amount to use if MAXIMUM is reached." :group 'matlab :type '(repeat (cons (character :tag "Open List Character") (sexp :tag "Number (max) or cons (max indent)")))) (defcustom matlab-handle-simulink t "*If true, add in a few simulink customizations. This variable's state is mostly useful when set at load time when simulink font lock keywords can be removed. This will handle additional cases as the need arrises." :group 'matlab :type 'boolean) (defcustom matlab-auto-fill t "*If true, set variable `auto-fill-function' to our function at startup." :group 'matlab :type 'boolean) (defcustom matlab-fill-fudge 10 "Number of characters around `fill-column' we can fudge filling. Basically, there are places that are very convenient to fill at, but might not be the closest fill spot, or occur after `fill-column'. If they occur within this fudge factor, we will use them. Also, if none of the above occur, and we find a symbol to break at, but an open paren (group) starts or ends within this fudge factor, move there to boost the amount of fill leverage we can get." :group 'matlab :type 'integer) (defcustom matlab-fill-fudge-hard-maximum 79 "The longest line allowed when auto-filling code. This overcomes situations where the `fill-column' plus the `matlab-fill-fudge' is greater than some hard desired limit." :group 'matlab :type 'integer) (defcustom matlab-elipsis-string "..." "Text used to perform continuation on code lines. This is used to generate and identify continuation lines.") (defcustom matlab-fill-code t "*If true, `auto-fill-mode' causes code lines to be automatically continued." :group 'matlab :type 'boolean) (defcustom matlab-fill-count-ellipsis-flag t "*Non-nil means to count the ellipsis when auto filling. This effectively shortens the `fill-column' by the length of `matlab-elipsis-string'.") (defcustom matlab-fill-strings-flag t "*Non-nil means that when auto-fill is on, strings are broken across lines. If `matlab-fill-count-ellipsis-flag' is non nil, this shortens the `fill-column' by the length of `matlab-elipsis-string'.") (defcustom matlab-comment-column 40 "*The goal comment column in `matlab-mode' buffers." :group 'matlab :type 'integer) (defcustom matlab-comment-anti-indent 0 "*Amount of anti-indentation to use for comments in relation to code." :group 'matlab :type 'integer) (defcustom matlab-comment-line-s "% " "*String to start comment on line by itself." :group 'matlab :type 'string) (defcustom matlab-comment-on-line-s "% " "*String to start comment on line with code." :group 'matlab :type 'string) (defcustom matlab-comment-region-s "% $$$ " "*String inserted by \\[matlab-comment-region] at start of each line in \ region." :group 'matlab :type 'string) (defcustom matlab-verify-on-save-flag t "*Non-nil means to verify M whenever we save a file." :group 'matlab :type 'boolean) (defcustom matlab-mode-verify-fix-functions '(matlab-mode-vf-functionname) "List of function symbols which perform a verification and fix to M code. Each function gets no arguments, and returns nothing. They can move point, but it will be restored for them." :group 'matlab :type '(repeat (choice :tag "Function: " '(matlab-mode-vf-functionname matlab-mode-vf-block-matches-forward matlab-mode-vf-block-matches-backward matlab-mode-vf-quiesce-buffer )))) (defcustom matlab-block-verify-max-buffer-size 50000 "*Largest buffer size allowed for block verification during save." :group 'matlab :type 'integer) ;; It is time to disable this. (defcustom matlab-vers-on-startup nil "*If non-nil, show the version number on startup." :group 'matlab :type 'boolean) (defcustom matlab-highlight-block-match-flag t "*Non-nil means to highlight the matching if/end/whatever. The highlighting only occurs when the cursor is on a block start or end keyword." :group 'matlab :type 'boolean) (defcustom matlab-show-periodic-code-details-flag nil "*Non-nil means to show code details in the minibuffer. This will only work if `matlab-highlight-block-match-flag' is non-nil." :group 'matlab :type 'boolean) (defcustom matlab-use-eei t "*Use Emacs Link for save-and-go and run-region." :group 'matlab :type 'boolean) (defcustom matlab-mode-hook nil "*List of functions to call on entry to MATLAB mode." :group 'matlab :type 'hook) (defcustom matlab-completion-technique 'complete "*How the `matlab-complete-symbol' interfaces with the user. Valid values are: 'increment - which means that new strings are tried with each successive call until all methods are exhausted. (Similar to `hippie-expand'.) 'complete - Which means that if there is no single completion, then all possibilities are displayed in a completion buffer." :group 'matlab :type '(radio (const :tag "Incremental completion (hippie-expand)." increment) (const :tag "Show completion buffer." complete))) (defcustom matlab-show-mlint-warnings nil "*If non-nil, show mlint warnings." :group 'matlab :type 'boolean) (make-variable-buffer-local 'matlab-show-mlint-warnings) (defcustom matlab-highlight-cross-function-variables nil "*If non-nil, highlight cross-function variables." :group 'matlab :type 'boolean) (make-variable-buffer-local 'matlab-highlight-cross-function-variables) (defcustom matlab-return-add-semicolon nil "*If non nil, check to see a semicolon is needed when RET is pressed." :group 'matlab :type 'boolean) (make-variable-buffer-local 'matlab-return-add-semicolon) ;; Load in the region we use for highlighting stuff. (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) (let ((l-region-face (if (facep 'region) 'region 'zmacs-region))) ;; If we have custom, we can make our own special face like this (defface matlab-region-face (list (list t (list :background (face-background l-region-face) :foreground (face-foreground l-region-face)))) "*Face used to highlight a matlab region." :group 'matlab)) ;; If we do not, then we can fake it by copying 'region. (cond ((facep 'region) (copy-face 'region 'matlab-region-face)) (t (copy-face 'zmacs-region 'matlab-region-face)))) (defvar matlab-unterminated-string-face 'matlab-unterminated-string-face "Self reference for unterminated string face.") (defvar matlab-simulink-keyword-face 'matlab-simulink-keyword-face "Self reference for simulink keywords.") (defvar matlab-nested-function-keyword-face 'matlab-nested-function-keyword-face "Self reference for nested function/end keywords.") (defvar matlab-cross-function-variable-face 'matlab-cross-function-variable-face "Self reference for cross-function variables.") (defvar matlab-cellbreak-face 'matlab-cellbreak-face "Self reference for cellbreaks.") (defun matlab-font-lock-adjustments () "Make adjustments for font lock. If font lock is not loaded, lay in wait." (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) (progn (defface matlab-unterminated-string-face (list (list t (list :background (face-background font-lock-string-face) :foreground (face-foreground font-lock-string-face) :underline t))) "*Face used to highlight unterminated strings." :group 'matlab) (defface matlab-simulink-keyword-face (list (list t (list :background (face-background font-lock-type-face) :foreground (face-foreground font-lock-type-face) :underline t))) "*Face used to highlight simulink specific functions." :group 'matlab) (defface matlab-nested-function-keyword-face (list (list t (list :slant 'italic))) "*Face to use for cross-function variables.") (defface matlab-cross-function-variable-face (list (list t (list :weight 'bold :slant 'italic))) "*Face to use for cross-function variables." :group 'matlab) (defface matlab-cellbreak-face (list (list t (list :background (face-background font-lock-comment-face) :foreground (face-foreground font-lock-comment-face) :overline t :bold t))) "*Face to use for cellbreak %% lines.") ) ;; Now, lets make the unterminated string face (cond ((facep 'font-lock-string-face) (copy-face 'font-lock-string-face 'matlab-unterminated-string-face)) (t (make-face 'matlab-unterminated-string-face))) (set-face-underline-p 'matlab-unterminated-string-face t) ;; Now make some simulink faces (cond ((facep 'font-lock-type-face) (copy-face 'font-lock-type-face 'matlab-simulink-keyword-face)) (t (make-face 'matlab-simulink-keyword-face))) (set-face-underline-p 'matlab-simulink-keyword-face t) ;; Now make some nested function/end keyword faces (cond ((facep 'font-lock-type-face) (copy-face 'font-lock-type-face 'matlab-nested-function-keyword-face)) (t (make-face 'matlab-nested-function-keyword-face))) ;; Now make some cross-function variable faces (cond ((facep 'font-lock-type-face) (copy-face 'font-lock-type-face 'matlab-cross-function-variable-face)) (t (make-face 'matlab-cross-function-variable-face))) (set-face-bold-p 'matlab-cross-function-variable-face t) ;; Now make some cellbreak variable faces (cond ((facep 'font-comment-face) (copy-face 'font-lock-comment-face 'matlab-cellbreak-face)) (t (make-face 'matlab-cellbreak-face))) (set-face-bold-p 'matlab-cellbreak-face t) (condition-case nil (set-face-attribute 'matlab-cellbreak-face nil :overline t) (error nil)) ) (remove-hook 'font-lock-mode-hook 'matlab-font-lock-adjustments)) ;; Make the adjustments for font lock after it's loaded. ;; I found that eval-after-load was unreliable. (if (featurep 'font-lock) (matlab-font-lock-adjustments) (add-hook 'font-lock-mode-hook 'matlab-font-lock-adjustments)) ;;; MATLAB mode variables ===================================================== (defvar matlab-tempo-tags nil "List of templates used in MATLAB mode.") ;; syntax table (defvar matlab-mode-syntax-table (let ((st (make-syntax-table (standard-syntax-table)))) (modify-syntax-entry ?_ "_" st) (modify-syntax-entry ?% "<" st) (modify-syntax-entry ?\n ">" st) (modify-syntax-entry ?\\ "." st) (modify-syntax-entry ?\t " " 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) st) "The syntax table used in `matlab-mode' buffers.") (defvar matlab-mode-special-syntax-table (let ((st (copy-syntax-table matlab-mode-syntax-table))) ;; Make _ a part of words so we can skip them better (modify-syntax-entry ?_ "w" st) st) "The syntax table used when navigating blocks.") ;; abbrev table (defvar matlab-mode-abbrev-table nil "The abbrev table used in `matlab-mode' buffers.") (define-abbrev-table 'matlab-mode-abbrev-table ()) ;;; Keybindings =============================================================== (defvar matlab-help-map (let ((km (make-sparse-keymap))) (define-key km "r" 'matlab-shell-run-command) (define-key km "f" 'matlab-shell-describe-command) (define-key km "a" 'matlab-shell-apropos) (define-key km "v" 'matlab-shell-describe-variable) (define-key km "t" 'matlab-shell-topic-browser) km) "The help key map for `matlab-mode' and `matlab-shell-mode'.") (defvar matlab-insert-map (let ((km (make-sparse-keymap))) (define-key km "c" 'matlab-insert-next-case) (define-key km "e" 'matlab-insert-end-block) (define-key km "i" 'tempo-template-matlab-if) (define-key km "I" 'tempo-template-matlab-if-else) (define-key km "f" 'tempo-template-matlab-for) (define-key km "s" 'tempo-template-matlab-switch) (define-key km "t" 'tempo-template-matlab-try) (define-key km "w" 'tempo-template-matlab-while) (define-key km "F" 'tempo-template-matlab-function) (define-key km "'" 'matlab-stringify-region) ;; Not really inserts, but auto coding stuff (define-key km "\C-s" 'matlab-ispell-strings) (define-key km "\C-c" 'matlab-ispell-comments) km) "Keymap used for inserting simple texts based on context.") ;; mode map (defvar matlab-mode-map (let ((km (make-sparse-keymap))) (define-key km [return] 'matlab-return) (define-key km "%" 'matlab-electric-comment) (define-key km "\C-c;" 'matlab-comment-region) (define-key km "\C-c:" 'matlab-uncomment-region) (define-key km [(control c) return] 'matlab-comment-return) (define-key km [(control c) (control c)] matlab-insert-map) (define-key km [(control c) (control f)] 'matlab-fill-comment-line) (define-key km [(control c) (control j)] 'matlab-justify-line) (define-key km [(control c) (control q)] 'matlab-fill-region) (define-key km [(control c) (control s)] 'matlab-shell-save-and-go) (define-key km [(control c) (control r)] 'matlab-shell-run-region) (define-key km [(meta control return)] 'matlab-shell-run-cell) (define-key km [(control c) (control t)] 'matlab-show-line-info) (define-key km [(control c) ?. ] 'matlab-find-file-on-path) (define-key km [(control h) (control m)] matlab-help-map) (define-key km [(control j)] 'matlab-linefeed) (define-key km "\M-\r" 'newline) (define-key km [(meta \;)] 'matlab-comment) (define-key km [(meta q)] 'matlab-fill-paragraph) (define-key km [(meta a)] 'matlab-beginning-of-command) (define-key km [(meta e)] 'matlab-end-of-command) (define-key km [(meta j)] 'matlab-comment-line-break-function) (define-key km [(meta s)] 'matlab-show-matlab-shell-buffer) (define-key km "\M-\t" 'matlab-complete-symbol) (define-key km [(meta control f)] 'matlab-forward-sexp) (define-key km [(meta control b)] 'matlab-backward-sexp) (define-key km [(meta control q)] 'matlab-indent-sexp) (define-key km [(meta control a)] 'matlab-beginning-of-defun) (define-key km [(meta control e)] 'matlab-end-of-defun) (if (string-match "XEmacs" emacs-version) (define-key km [(control meta button1)] 'matlab-find-file-click) (define-key km [(control meta mouse-2)] 'matlab-find-file-click)) (substitute-key-definition 'comment-region 'matlab-comment-region km) ; global-map ;torkel km) "The keymap used in `matlab-mode'.") ;;; Font locking keywords ===================================================== (defvar matlab-string-start-regexp "\\(^\\|[^]})a-zA-Z0-9_.']\\)" "Regexp used to represent the character before the string char '. The ' character has restrictions on what starts a string which is needed when attempting to understand the current context.") ;; To quote a quote, put two in a row, thus we need an anchored ;; first quote. In addition, we don't want to color strings in comments. (defvar matlab-string-end-regexp "[^'\n]*\\(''[^'\n]*\\)*'" "Regexp used to represent the character pattern for ending a string. The ' character can be used as a transpose, and can transpose transposes. Therefore, to end, we must check all that goop.") (defun matlab-font-lock-string-match-normal (limit) "When font locking strings, call this function for normal strings. Argument LIMIT is the maximum distance to scan." (matlab-font-lock-string-match-here (concat matlab-string-start-regexp "\\('" matlab-string-end-regexp "\\)" "\\([^']\\|$\\)") limit)) (defun matlab-font-lock-string-match-unterminated (limit) "When font locking strings, call this function for normal strings. Argument LIMIT is the maximum distance to scan." (matlab-font-lock-string-match-here (concat matlab-string-start-regexp "\\('[^'\n]*\\(''[^'\n]*\\)*\\)$") limit)) (defun matlab-font-lock-string-match-here (regex limit) "When font-locking strings, call this function to determine a match. Argument REGEX is the expression to scan for. Match 2 must be the string. Argument LIMIT is the maximum distance to scan." (let (e) (while (and (re-search-forward regex limit t) (progn ;; This gets us out of a comment after the string. (setq e (match-end 2)) (goto-char (match-beginning 2)) (prog1 (or (matlab-cursor-in-comment) (if (bolp) nil (save-excursion (forward-char -1) (matlab-cursor-in-string)))) (goto-char e)))) (setq e nil)) (if (not e) nil (goto-char e) t))) (defun matlab-font-lock-comment-match (limit) "When font-locking comments, call this function to determine a match. Argument LIMIT is the maximum distance to scan." (let (e) (while (and (re-search-forward "\\(%[^%\n]*\\)" limit t) (progn (setq e (match-end 1)) (member (get-text-property (match-beginning 0) 'face) '(font-lock-string-face matlab-unterminated-string-face)))) (setq e nil)) (if (not e) nil (goto-char e) t))) (defun matlab-find-unreachable-code (limit) "Find code that is if'd out with if(0) or if(false), and mark it as a comment. The if(0) and else/end construct should be highlighted differently. Argument LIMIT is the maximum distance to search." (if (and (< (point) limit) (re-search-forward "\\<\\(if\\>\\s-*(?\\s-*\\(0\\|false\\)\\s-*)?$\\)" limit t)) (let ((b1 (match-beginning 1)) (e1 (match-end 1)) (b2 nil) (e2 nil) (b3 nil) (e3 nil)) (goto-char b1) (condition-case nil (progn ;; Go forward over the matlab sexp. Include scanning ;; for ELSE since parts of the ELSE block are not ;; `commented out'. (matlab-forward-sexp t) (forward-word -1) ;; Is there an ELSE in this block? (if (looking-at (matlab-block-mid-re)) (progn (setq b3 (match-beginning 0) e3 (match-end 0)) ;; Now find the REAL end. (matlab-forward-sexp) (forward-word -1))) ;; End of block stuff (if (looking-at (matlab-block-end-re)) (progn (setq b2 (match-beginning 0) e2 (match-end 0)) ;; make sure something exists... (if (not b3) (setq b3 b2 e3 e2))) (error "Eh?")) ;; Ok, build up some match data. (set-match-data (list b1 e2 ;the real deal. b1 e1 ;if (0) b2 e2 ;end b3 e3 ;else (if applicable.) b1 e3)) ;body commented out. t) (error nil))))) (defun matlab-font-lock-nested-function-keyword-match (limit) "Find next nested function/end keyword for font-lock. Argument LIMIT is the maximum distance to search." ; Because of the way overlays are setup, the cursor will be sitting ; on either a "function" or "end" keyword. (catch 'result (let ((pos (point)) overlays) (while (< pos limit) (setq overlays (matlab-overlays-at pos)) (while overlays (let ((overlay (car overlays))) (when (matlab-overlay-get overlay 'nested-function) (when (= pos (matlab-overlay-start overlay)) (goto-char pos) ;; The following line presumably returns true. (throw 'result (re-search-forward "function" (+ pos 8) t))) (let ((end-of-overlay (- (matlab-overlay-end overlay) 3))) (when (<= pos end-of-overlay) (goto-char end-of-overlay) (throw 'result (re-search-forward "end" (+ end-of-overlay 3) t)))))) (setq overlays (cdr overlays))) (setq pos (matlab-next-overlay-change pos))) nil ;; no matches, stop ))) (defun matlab-font-lock-cross-function-variables-match (limit) "Find next cross-function variable for font-lock. Argument LIMIT is the maximum distance to search." (catch 'result (let ((pos (point)) overlays variables) (while (< pos limit) (let ((overlays (matlab-overlays-at pos))) (while overlays (let ((overlay (car overlays))) (setq variables (matlab-overlay-get overlay 'cross-function-variables)) (if variables (progn (goto-char pos) (setq pos (min limit (matlab-overlay-end overlay))) (if (re-search-forward variables pos t) (progn (throw 'result t)))))) (setq overlays (cdr overlays)))) (setq pos (matlab-next-overlay-change pos))) nil ;; no matches, stop ))) (defun matlab-find-block-comments (limit) "Find code that is commented out with %{ until %}. Argument LIMIT is the maximum distance to search." (if (and (< (point) limit) (re-search-forward "%{" limit t)) (let ((b1 (match-beginning 0)) (e1 (match-end 0)) (b2 nil) (e2 nil) (b3 nil) (e3 nil)) (goto-char b1) (forward-char -1) (when (not (matlab-cursor-in-comment)) (setq b2 (re-search-forward "%}" limit t)) (when b2 (setq b2 (match-beginning 0) e2 (match-end 0)) (set-match-data (list b1 e2 ; full match b1 e2 ; the full comment b1 e1 ; the block start b2 e2 ; the block end )) t ))))) (defcustom matlab-keyword-list '("global" "persistent" "for" "parfor" "while" "spmd" "if" "elseif" "else" "endfunction" "return" "break" "continue" "switch" "case" "otherwise" "try" "catch" "tic" "toc" ;; MCOS keywords "classdef" "properties" "methods" "enumeration" ) "List of keywords for MATLAB used in highlighting. Customizing this variable is only useful if `regexp-opt' is available." :group 'matlab :type '(repeat (string :tag "Keyword: "))) (defcustom matlab-handle-graphics-list '("figure" "axes" "axis" "line" "surface" "patch" "text" "light" "image" "set" "get" "uicontrol" "uimenu" "uitoolbar" "uitoggletool" "uipushtool" "uicontext" "uicontextmenu" "setfont" "setcolor") "List of handle graphics functions used in highlighting. Customizing this variable is only useful if `regexp-opt' is available." :group 'matlab :type '(repeat (string :tag "HG Keyword: "))) (defcustom matlab-debug-list '("dbstop" "dbclear" "dbcont" "dbdown" "dbmex" "dbstack" "dbstatus" "dbstep" "dbtype" "dbup" "dbquit") "List of debug commands used in highlighting. Customizing this variable is only useful if `regexp-opt' is available." :group 'matlab :type '(repeat (string :tag "Debug Keyword: "))) ;; font-lock keywords (defvar matlab-font-lock-keywords (list ;; String quote chars are also used as transpose, but only if directly ;; after characters, numbers, underscores, or closing delimiters. '(matlab-font-lock-string-match-normal 2 font-lock-string-face) ;; A string with no termination is not currently highlighted. ;; This will show that the string needs some attention. '(matlab-font-lock-string-match-unterminated 2 matlab-unterminated-string-face) ;; Comments must occur after the string, that way we can check to see ;; if the comment start char has occurred inside our string. (EL) '(matlab-font-lock-comment-match 1 font-lock-comment-face) ;; Various pragmas should be in different colors. ;; I think pragmas are always lower case? '("%#\\([a-z]+\\)" (1 'bold prepend)) ;; General keywords (list (if (fboundp 'regexp-opt) (concat "\\<\\(" (regexp-opt matlab-keyword-list) "\\)\\>") ;; Original hard-coded value for pre Emacs 20.1 "\\<\\(break\\|ca\\(se\\|tch\\)\\|e\\(lse\\(\\|if\\)\\|ndfunction\\)\ \\|\\(par\\)?for\\|spmd\\|global\\|if\\|otherwise\\|return\\|switch\\|try\\|while\\|tic\\|toc\\)\\>") '(0 font-lock-keyword-face)) ;; The end keyword is only a keyword when not used as an array ;; dereferencing part. '("\\(^\\|[;,]\\)[ \t]*\\(end\\)\\b" 2 (if (matlab-valid-end-construct-p) font-lock-keyword-face nil)) ;; How about unreachable code? MUsT BE AFTER KEYWORDS in order to ;; get double-highlighting. '(matlab-find-unreachable-code (1 'underline prepend) ;if part (2 'underline prepend) ;end part (3 'underline prepend) ;else part (if applicable) (4 font-lock-comment-face prepend) ;commented out part. ) ;; block comments need to be commented out too! '(matlab-find-block-comments (1 font-lock-comment-face prepend) ; commented out (2 'underline prepend) (3 'underline prepend) ;the comment parts ) ;; Cell mode breaks get special treatment '("^\\s-*\\(%%[^\n]*\n\\)" (1 matlab-cellbreak-face append)) ;; Highlight cross function variables '(matlab-font-lock-cross-function-variables-match (1 matlab-cross-function-variable-face prepend)) ;; Highlight nested function/end keywords '(matlab-font-lock-nested-function-keyword-match (0 matlab-nested-function-keyword-face prepend)) ;; The global keyword defines some variables. Mark them. '("^\\s-*global\\s-+" ("\\(\\w+\\)\\(\\s-*=[^,; \t\n]+\\|[, \t;]+\\|$\\)" nil nil (1 font-lock-variable-name-face))) ;; Handle graphics stuff (list (if (fboundp 'regexp-opt) (concat "\\<\\(" (regexp-opt matlab-handle-graphics-list) "\\)\\>") ;; The original regular expression for pre Emacs 20.1 "\\<\\(ax\\(es\\|is\\)\\|figure\\|get\\|image\\|li\\(ght\\|ne\\)\\|\ patch\\|s\\(et\\(\\|color\\|font\\)\\|urface\\)\\|text\\|\ ui\\(cont\\(ext\\(\\|menu\\)\\|rol\\)\\|menu\\|\ \\(toggle\\|push\\)tool\\|toolbar\\)\\)\\>") '(0 font-lock-type-face)) ) "Expressions to highlight in MATLAB mode.") (defconst matlab-function-arguments "\\(([^)]*)\\)?\\s-*\\([,;\n%]\\|$\\)") (defvar matlab-gaudy-font-lock-keywords (append matlab-font-lock-keywords (list ;; defining a function, a (possibly empty) list of assigned variables, ;; function name, and an optional (possibly empty) list of input variables (list (concat "^\\s-*\\(function\\)\\>[ \t\n.]*" "\\(\\[[^]]*\\]\\|\\sw+\\)[ \t\n.]*" "=[ \t\n.]*\\(\\sw+\\)[ \t\n.]*" matlab-function-arguments) '(1 font-lock-keyword-face append) '(2 font-lock-variable-name-face append) '(3 font-lock-function-name-face append)) ;; defining a function, a function name, and an optional (possibly ;; empty) list of input variables (list (concat "^\\s-*\\(function\\)[ \t\n.]+" "\\(\\sw+\\)[ \t\n.]*" matlab-function-arguments) '(1 font-lock-keyword-face append) '(2 font-lock-function-name-face append)) ;; Anchor on the function keyword, highlight params (list (concat "^\\s-*function\\>[ \t\n.]*" "\\(\\(\\[[^]]*\\]\\|\\sw+\\)[ \t\n.]*=[ \t\n.]*\\)?" "\\sw+\\s-*(") '("\\s-*\\(\\sw+\\)\\s-*[,)]" nil nil (1 font-lock-variable-name-face))) ;; I like variables for FOR loops '("\\<\\(for\\|parfor\\)\\s-+\\(\\sw+\\)\\s-*=\\s-*\ \\(\\([^\n,;%(]+\\|([^\n%)]+)\\)+\\)" (1 font-lock-keyword-face) (2 font-lock-variable-name-face append) (3 font-lock-reference-face append)) ;; Items after a switch statements are cool '("\\<\\(case\\|switch\\)\\s-+\\({[^}\n]+}\\|[^,%\n]+\\)" (1 font-lock-keyword-face) (2 font-lock-reference-face)) ;; How about a few matlab constants such as pi, infinity, and sqrt(-1)? ;; The ^>> is in case I use this in an interactive mode someday '("\\<\\(eps\\|pi\\|inf\\|Inf\\|NaN\\|nan\\|ans\\|i\\|j\\|^>>\\)\\>" 1 font-lock-reference-face) '("\\<[0-9]\\.?\\(i\\|j\\)\\>" 1 font-lock-reference-face) ;; Define these as variables since this is about as close ;; as matlab gets to variables (list (concat "\\<" matlab-indent-past-arg1-functions "\\s-*") '("(\\s-*\\(\\w+\\)\\s-*\\(,\\|)\\)" nil nil (1 font-lock-variable-name-face))) )) "Expressions to highlight in MATLAB mode.") (defvar matlab-really-gaudy-font-lock-keywords (append matlab-gaudy-font-lock-keywords (list ;; Since it's a math language, how bout dem symbols? '("\\([<>~]=?\\|\\.[/*^']\\|==\\|\\\\|[-!^&|*+\\/~:]\\)" 1 font-lock-type-face) ;; How about references in the HELP text. (list (concat "^" matlab-comment-line-s "\\s-*" "\\(\\([A-Z]+\\s-*=\\s-+\\|\\[[^]]+]\\s-*=\\s-+\\|\\)" "\\([A-Z][0-9A-Z]+\\)\\(([^)\n]+)\\| \\)\\)") '(1 font-lock-reference-face prepend)) (list (concat "^" matlab-comment-line-s "\\s-*" "See also\\s-+") '("\\([A-Z][A-Z0-9]+\\)\\([,.]\\| and\\|$\\) *" nil nil (1 font-lock-reference-face prepend))) (list (concat "^" matlab-comment-line-s "\\s-*" "\\(\\$" "Revision" "[^\n$]+\\$\\)") '(1 font-lock-reference-face prepend)) ;; continuation ellipsis. '("[^.]\\(\\.\\.\\.+\\)\\([^\n]*\\)" (1 'underline) (2 font-lock-comment-face)) ;; How about debugging statements? ;;'("\\<\\(db\\sw+\\)\\>" 1 'bold) (list (if (fboundp 'regexp-opt) (concat "\\<\\(" (regexp-opt matlab-debug-list) "\\)\\>") ;; pre-regexp-opt days. "\\<\\(db\\(c\\(lear\\|ont\\)\\|down\\|mex\\|quit\\|\ st\\(a\\(ck\\|tus\\)\\|ep\\|op\\)\\|type\\|up\\)\\)\\>") '(0 'bold))) (if matlab-handle-simulink ;; Simulink functions, but only if the user wants it. (list (list (concat "\\<\\(\\([sg]et_param\\|sim\\([gs]et\\)?\\|" "\\(mld\\|ss\\)[A-Z]\\w+\\)\\|" "\\(new\\|open\\|close\\|save\\|find\\)_system\\|" "\\(add\\|delete\\|replace\\)_\\(block\\|line\\)\\|" "simulink\\|bd\\(root\\|close\\)" "\\)\\>") 1 matlab-simulink-keyword-face)) nil)) "Expressions to highlight in MATLAB mode.") (defvar matlab-shell-font-lock-keywords (list ;; How about Errors? '("^\\(Error in\\|Syntax error in\\)\\s-+==>\\s-+\\(.+\\)$" (1 font-lock-comment-face) (2 font-lock-string-face)) ;; and line numbers '("^\\(On line [0-9]+\\)" 1 font-lock-comment-face) ;; User beep things '("\\(\\?\\?\\?[^\n]+\\)" 1 font-lock-comment-face) ;; Useful user commands, but not useful programming constructs '("\\<\\(demo\\|whatsnew\\|info\\|subscribe\\|help\\|doc\\|lookfor\\|what\ \\|whos?\\|cd\\|clear\\|load\\|save\\|helpdesk\\|helpwin\\)\\>" 1 font-lock-keyword-face) ;; Various notices '(" M A T L A B " 0 'underline) '("All Rights Reserved" 0 'italic) '("\\((c)\\s-+Copyright[^\n]+\\)" 1 font-lock-comment-face) '("\\(Version\\)\\s-+\\([^\n]+\\)" (1 font-lock-function-name-face) (2 font-lock-variable-name-face)) ) "Additional keywords used by MATLAB when reporting errors in interactive\ mode.") ;; Imenu support. (defvar matlab-imenu-generic-expression '((nil "^\\s-*function\\>[ \t\n.]*\\(\\(\\[[^]]*\\]\\|\\sw+\\)[ \t\n.]*\ < =\[ \t\n.]*\\)?\\([a-zA-Z0-9_]+\\)" 3)) "Expressions which find function headings in MATLAB M files.") ;;; MATLAB mode entry point ================================================== ;;;###autoload (add-to-list 'auto-mode-alist '("\\.m$" . matlab-mode)) ;;;###autoload (defun matlab-mode () "MATLAB(R) mode is a major mode for editing MATLAB dot-m files. \\ Convenient editing commands are: \\[matlab-comment-region] - Comment/Uncomment out a region of code. \\[matlab-fill-comment-line] - Fill the current comment line. \\[matlab-fill-region] - Fill code and comments in region. \\[matlab-fill-paragraph] - Refill the current command or comment. \\[matlab-complete-symbol] - Symbol completion of matlab symbols\ based on the local syntax. \\[matlab-indent-sexp] - Indent syntactic block of code. Convenient navigation commands are: \\[matlab-beginning-of-command] - Move to the beginning of a command. \\[matlab-end-of-command] - Move to the end of a command. \\[matlab-beginning-of-defun] - Move to the beginning of a function. \\[matlab-end-of-defun] - Move do the end of a function. \\[matlab-forward-sexp] - Move forward over a syntactic block of code. \\[matlab-backward-sexp] - Move backwards over a syntactic block of code. Convenient template insertion commands: \\[tempo-template-matlab-function] - Insert a function definition. \\[tempo-template-matlab-if] - Insert an IF END block. \\[tempo-template-matlab-for] - Insert a FOR END block. \\[tempo-template-matlab-switch] - Insert a SWITCH END statement. \\[matlab-insert-next-case] - Insert the next CASE condition in a SWITCH. \\[matlab-insert-end-block] - Insert a matched END statement. With \ optional ARG, reindent. \\[matlab-stringify-region] - Convert plaintext in region to a string \ with correctly quoted chars. Variables: `matlab-indent-level' Level to indent blocks. `matlab-cont-level' Level to indent continuation lines. `matlab-cont-requires-ellipsis' Does your MATLAB support implied elipsis. `matlab-case-level' Level to unindent case statements. `matlab-indent-past-arg1-functions' Regexp of functions to indent past the first argument on continuation lines. `matlab-maximum-indents' List of maximum indents during lineups. `matlab-comment-column' Goal column for on-line comments. `fill-column' Column used in auto-fill. `matlab-indent-function-body' If non-nil, indents body of MATLAB functions. `matlab-functions-have-end' If non-nil, MATLAB functions terminate with end. `matlab-return-function' Customize RET handling with this function. `matlab-auto-fill' Non-nil, do auto-fill at startup. `matlab-fill-code' Non-nil, auto-fill code. `matlab-fill-strings' Non-nil, auto-fill strings. `matlab-verify-on-save-flag' Non-nil, enable code checks on save. `matlab-highlight-block-match-flag' Enable matching block begin/end keywords. `matlab-vers-on-startup' If t, show version on start-up. `matlab-handle-simulink' If t, enable simulink keyword highlighting. All Key Bindings: \\{matlab-mode-map}" (interactive) (kill-all-local-variables) (use-local-map matlab-mode-map) (setq major-mode 'matlab-mode) (setq mode-name "MATLAB") (if (boundp 'whitespace-modes) (add-to-list 'whitespace-modes 'matlab-mode)) (setq local-abbrev-table matlab-mode-abbrev-table) (set-syntax-table matlab-mode-syntax-table) (setq indent-tabs-mode nil) (make-local-variable 'indent-line-function) (setq indent-line-function 'matlab-indent-line) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'comment-start-skip) (setq comment-start-skip "%\\s-+") (make-local-variable 'comment-start) (setq comment-start "%") (make-local-variable 'page-delimiter) (setq page-delimiter "^\\(\f\\|%%\\(\\s-\\|\n\\)\\)") (make-local-variable 'comment-column) (setq comment-column matlab-comment-column) (make-local-variable 'comment-indent-function) (setq comment-indent-function 'matlab-comment-indent) (make-local-variable 'add-log-current-defun-function) (setq add-log-current-defun-function 'matlab-current-defun) (make-local-variable 'fill-column) (setq fill-column default-fill-column) (make-local-variable 'auto-fill-function) (if matlab-auto-fill (setq auto-fill-function 'matlab-auto-fill)) ;; Emacs 20 supports this variable. This lets users turn auto-fill ;; on and off and still get the right fill function. (make-local-variable 'normal-auto-fill-function) (setq normal-auto-fill-function 'matlab-auto-fill) (make-local-variable 'fill-prefix) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression matlab-imenu-generic-expression) ;; Save hook for verifying src. This lets us change the name of ;; the function in `write-file' and have the change be saved. ;; It also lets us fix mistakes before a `save-and-go'. (make-local-variable 'write-contents-hooks) (add-hook 'write-contents-hooks 'matlab-mode-verify-fix-file-fn) ;; Tempo tags (make-local-variable 'tempo-local-tags) (setq tempo-local-tags (append matlab-tempo-tags tempo-local-tags)) ;; give each file it's own parameter history (make-local-variable 'matlab-shell-save-and-go-history) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '((matlab-font-lock-keywords matlab-gaudy-font-lock-keywords matlab-really-gaudy-font-lock-keywords ) t ; do not do string/comment highlighting nil ; keywords are case sensitive. ;; This puts _ as a word constituent, ;; simplifying our keywords significantly ((?_ . "w")))) (matlab-enable-block-highlighting 1) (if window-system (matlab-frame-init)) ;; If first function is terminated with an end statement, then functions have ;; ends. (if (matlab-do-functions-have-end-p) (matlab-functions-have-end-minor-mode 1) (matlab-functions-have-end-minor-mode -1) ) ;; When matlab-indent-function-body is set to 'MathWorks-Standard, ;; - we indent all functions that terminate with an end statement ;; - old style functions (those without end statements) are not ;; indented. ;; It is desired that all code be terminate with an end statement. ;; ;; When matlab-indent-function-body is set to 'guess, ;; - look at the first line of code and if indented, keep indentation ;; otherwise use MathWorks-Standard ;; (cond ((eq matlab-indent-function-body 'MathWorks-Standard) ) ((eq matlab-indent-function-body 'guess) (save-excursion (goto-char (point-max)) (if (re-search-backward matlab-defun-regex nil t) (let ((beg (point)) end ; filled in later (cc (current-column)) ) (setq end (if matlab-functions-have-end (progn (forward-line 0) (point)) (point-max))) (goto-char beg) (catch 'done (while (progn (forward-line 1) (< (point) end)) (if (looking-at "\\s-*\\(%\\|$\\)") nil ; go on to next line (looking-at "\\s-*") (goto-char (match-end 0)) (setq matlab-indent-function-body (> (current-column) cc)) (throw 'done nil)))) ) (setq matlab-indent-function-body 'MathWorks-Standard) )) ) (t) ) (if (or (featurep 'mlint) matlab-show-mlint-warnings matlab-highlight-cross-function-variables) ;; Some users may not feel like getting all the extra stuff ;; needed for mlint working. Do this only if we can get ;; mlint loaded ok. (condition-case nil (mlint-minor-mode (if (or matlab-show-mlint-warnings matlab-highlight-cross-function-variables) 1 0)) ;; If there is an error loading the stuff, don't ;; continue. (error nil))) (save-excursion (goto-char (point-min)) (run-hooks 'matlab-mode-hook)) (if matlab-vers-on-startup (matlab-show-version))) ;;; Utilities ================================================================= (defun matlab-show-version () "Show the version number in the minibuffer." (interactive) (message "matlab-mode, version %s" matlab-mode-version)) (defun matlab-find-prev-line () "Recurse backwards until a code line is found." (if (= -1 (forward-line -1)) nil (if (or (matlab-ltype-empty) (matlab-ltype-comm-ignore)) (matlab-find-prev-line) t))) (defun matlab-prev-line () "Go to the previous line of code. Return nil if not found." (interactive) (let ((old-point (point))) (if (matlab-find-prev-line) t (goto-char old-point) nil))) (defun matlab-uniquafy-list (lst) "Return a list that is a subset of LST where all elements are unique." (let ((nlst nil)) (while lst (if (and (car lst) (not (member (car lst) nlst))) (setq nlst (cons (car lst) nlst))) (setq lst (cdr lst))) (nreverse nlst))) ; Aki Vehtari recommends this: (19.29 required) ;(require 'backquote) ;(defmacro matlab-navigation-syntax (&rest body) ; "Evaluate BODY with the matlab-mode-special-syntax-table" ; '(let ((oldsyntax (syntax-table))) ; (unwind-protect ; (progn ; (set-syntax-table matlab-mode-special-syntax-table) ; ,@body) ; (set-syntax-table oldsyntax)))) (defmacro matlab-navigation-syntax (&rest forms) "Set the current environment for syntax-navigation and execute FORMS." (list 'let '((oldsyntax (syntax-table)) (case-fold-search nil)) (list 'unwind-protect (list 'progn '(set-syntax-table matlab-mode-special-syntax-table) (cons 'progn forms)) '(set-syntax-table oldsyntax)))) (put 'matlab-navigation-syntax 'lisp-indent-function 0) (add-hook 'edebug-setup-hook (lambda () (def-edebug-spec matlab-navigation-syntax def-body))) (defun matlab-up-list (count &optional restrict) "Move forwards or backwards up a list by COUNT. Optional argument RESTRICT is where to restrict the search." ;; MATLAB syntax table has no disabling strings or comments. (let ((dir (if (> 0 count) -1 +1)) (origin (point)) (ms nil)) ;; Make count positive (setq count (* count dir)) (if (= dir -1) (while (/= count 0) ;; Search till we find an unstrung paren object. (setq ms (re-search-backward "\\s(\\|\\s)" restrict t)) (while (and (save-match-data (matlab-cursor-in-string-or-comment)) (setq ms (re-search-backward "\\s(\\|\\s)" restrict t)))) (if (not ms) (progn (goto-char origin) (error "Scan Error: List missmatch"))) ;; View it's match. (let ((s (match-string 0))) (if (string-match "\\s(" s) (setq count (1- count)) (setq count (1+ count))))) (error "Not implemented")) ms)) (defun matlab-valid-end-construct-p () "Return non-nil if the end after point terminates a block. Return nil if it is being used to dereference an array." (let ((p (point)) (err1 t)) (condition-case nil (save-restriction ;; Restrict navigation only to the current command line (save-excursion (matlab-beginning-of-command) (narrow-to-region (point) (save-excursion (goto-char p) (matlab-point-at-eol)))) ;; This used to add some sort of protection, but I don't know what ;; the condition was, or why the simple case doesn't handle it. ;; ;; The above replacement fixes a case where a continuation in an array ;; befuddles the indenter. ;; (progn ;;(matlab-end-of-command (point)) ;; (end-of-line) ;; (if (> p (point)) ;; (progn ;; (setq err1 nil) ;; (error))) ;; (point)))) (save-excursion ;; beginning of param list (matlab-up-list -1) ;; backup over the parens. If that fails (condition-case nil (progn (forward-sexp 1) ;; If we get here, the END is inside parens, which is not a ;; valid location for the END keyword. As such it is being ;; used to dereference array parameters nil) ;; This error means that we have an unterminated paren ;; block, so this end is currently invalid. (error nil)))) ;; an error means the list navigation failed, which also means we are ;; at the top-level (error err1)))) ;;; Regexps for MATLAB language =============================================== ;; "-pre" means "partial regular expression" ;; "-if" and "-no-if" means "[no] Indent Function" (defconst matlab-defun-regex "^\\(\\s-*function\\|classdef\\)[ \t.[]" "Regular expression defining the beginning of a MATLAB function.") (defconst matlab-mcos-regexp "\\|classdef\\|properties\\|methods\\|enumeration" "Keywords which mark the beginning of mcos blocks.") (defcustom matlab-block-indent-tic-toc-flag nil "*Non-nil means that tic,toc should indent like a if,end block. This variable should be set before loading matlab.el" :group 'matlab :type 'boolean) (defconst matlab-block-beg-pre-if (if matlab-block-indent-tic-toc-flag (concat "function\\|parfor\\|spmd\\|for\\|while\\|if\\|switch\\|try\\|tic" matlab-mcos-regexp) (concat "function\\|parfor\\|spmd\\|for\\|while\\|if\\|switch\\|try" matlab-mcos-regexp)) "Keywords which mark the beginning of an indented block. Includes function.") (defconst matlab-block-beg-pre-no-if (if matlab-block-indent-tic-toc-flag (concat "parfor\\|for\\|spmd\\|while\\|if\\|switch\\|try\\|tic" matlab-mcos-regexp) (concat "parfor\\|for\\|spmd\\|while\\|if\\|switch\\|try" matlab-mcos-regexp)) "Keywords which mark the beginning of an indented block. Excludes function.") (defun matlab-block-beg-pre () "Partial regular expression to recognize MATLAB block-begin keywords." (if matlab-functions-have-end matlab-block-beg-pre-if matlab-block-beg-pre-no-if)) (defconst matlab-block-mid-pre "elseif\\|else\\|catch" "Partial regular expression to recognize MATLAB mid-block keywords.") (defconst matlab-block-end-pre-if (if matlab-block-indent-tic-toc-flag "end\\(function\\)?\\|function\\|\\(\\sw+\\s-*\\((.*)\\)?\\s-*=\\s-*\\)?toc" "end\\(function\\)?\\|function") "Partial regular expression to recognize MATLAB block-end keywords.") (defconst matlab-block-end-pre-no-if (if matlab-block-indent-tic-toc-flag "end\\|\\(\\sw+\\s-*\\((.*)\\)?\\s-*=\\s-*\\)?toc" "end") "Partial regular expression to recognize MATLAB block-end keywords.") (defun matlab-block-end-pre () "Partial regular expression to recognize MATLAB block-end keywords." (if matlab-functions-have-end matlab-block-end-pre-if matlab-block-end-pre-no-if)) ;; Not used. ;;(defconst matlab-other-pre ;; "function\\|return" ;; "Partial regular express to recognize MATLAB non-block keywords.") (defconst matlab-endless-blocks "case\\|otherwise" "Keywords which initialize new blocks, but don't have explicit ends. Thus, they are endless. A new case or otherwise will end a previous endless block, and and end will end this block, plus any outside normal blocks.") (defun matlab-block-re () "Regular expression for keywords which begin MATLAB blocks." (concat "\\(^\\|[;,]\\)\\s-*\\(" (matlab-block-beg-pre) "\\|" matlab-block-mid-pre "\\|" (matlab-block-end-pre) "\\|" matlab-endless-blocks "\\)\\b")) (defun matlab-block-scan-re () "Expression used to scan over matching pairs of begin/ends." (concat "\\(^\\|[;,]\\)\\s-*\\(" (matlab-block-beg-pre) "\\|" (matlab-block-end-pre) "\\)\\b")) (defun matlab-block-beg-re () "Expression used to find the beginning of a block." (concat "\\(" (matlab-block-beg-pre) "\\)")) (defun matlab-block-mid-re () "Expression used to find block center parts (like else)." (concat "\\(" matlab-block-mid-pre "\\)")) (defun matlab-block-end-re () "Expression used to end a block. Usually just `end'." (concat "\\(" (matlab-block-end-pre) "\\)")) (defun matlab-block-end-no-function-re () "Expression representing and end if functions are excluded." (concat "\\<\\(" matlab-block-end-pre-no-if "\\)\\>")) (defun matlab-endless-blocks-re () "Expression of block starters that do not have associated ends." (concat "\\(" matlab-endless-blocks "\\)")) (defun matlab-match-function-re () "Expression to match a function start line. There are no reliable numeric matches in this expression. Know that `match-end' of 0 is the end of the functin name." ;; old function was too unstable. ;;"\\(^function\\s-+\\)\\([^=\n]+=[ \t\n.]*\\)?\\(\\sw+\\)" (concat "\\(^\\s-*function\\b[ \t\n.]*\\)\\(\\(\\[[^]]*\\]\\|\\sw+\\)" "[ \t\n.]*=[ \t\n.]*\\|\\(\\)\\)\\(\\sw+\\)")) (defconst matlab-cline-start-skip "[ \t]*%[ \t]*" "*The regular expression for skipping comment start.") ;;; Lists for matlab keywords ================================================= (defvar matlab-keywords-solo '("break" "case" "else" "elseif" "end" "for" "parfor" "function" "if" "tic" "toc" "otherwise" "profile" "switch" "while" "try" "catch" "spmd") "Keywords that appear on a line by themselves.") (defvar matlab-keywords-return '("acos" "acosh" "acot" "acoth" "acsch" "asech" "asin" "asinh" "atan" "atan2" "atanh" "cos" "cosh" "coth" "csc" "csch" "exp" "log" "log10" "log2" "sec" "sech" "sin" "sinh" "tanh" "abs" "sign" "sqrt" ) "List of MATLAB keywords that have return arguments. This list still needs lots of help.") (defvar matlab-keywords-boolean '("all" "any" "exist" "isempty" "isequal" "ishold" "isfinite" "isglobal" "isinf" "isletter" "islogical" "isnan" "isprime" "isreal" "isspace" "logical" "isa") "List of keywords that are typically used as boolean expressions.") (defvar matlab-core-properties '("ButtonDownFcn" "Children" "Clipping" "CreateFcn" "DeleteFcn" "BusyAction" "HandleVisibility" "HitTest" "Interruptible" "Parent" "Selected" "SelectionHighlight" "Tag" "Type" "UIContextMenu" "UserData" "Visible") "List of properties belonging to all HG objects.") (defvar matlab-property-lists '(("root" . ("CallbackObject" "Language" "CurrentFigure" "Diary" "DiaryFile" "Echo" "ErrorMessage" "Format" "FormatSpacing" "PointerLocation" "MonitorPositions" "PointerWindow" "Profile" "ProfileFile" "ProfileCount" "ProfileInterval" "RecursionLimit" "ScreenDepth" "ScreenSize" "ShowHiddenHandles" "TerminalHideGraphCommand" "TerminalOneWindow" "TerminalDimensions" "TerminalProtocol" "TerminalShowGraphCommand" "Units" "AutomaticFileUpdates" )) ("axes" . ("AmbientLightColor" "Box" "CameraPosition" "CameraPositionMode" "CameraTarget" "CameraTargetMode" "CameraUpVector" "CameraUpVectorMode" "CameraViewAngle" "CameraViewAngleMode" "CLim" "CLimMode" "Color" "CurrentPoint" "ColorOrder" "DataAspectRatio" "DataAspectRatioMode" "DrawMode" "FontAngle" "FontName" "FontSize" "FontUnits" "FontWeight" "GridLineStyle" "Layer" "LineStyleOrder" "LineWidth" "NextPlot" "PlotBoxAspectRatio" "PlotBoxAspectRatioMode" "Projection" "Position" "TickLength" "TickDir" "TickDirMode" "Title" "Units" "View" "XColor" "XDir" "XGrid" "XLabel" "XAxisLocation" "XLim" "XLimMode" "XScale" "XTick" "XTickLabel" "XTickLabelMode" "XTickMode" "YColor" "YDir" "YGrid" "YLabel" "YAxisLocation" "YLim" "YLimMode" "YScale" "YTick" "YTickLabel" "YTickLabelMode" "YTickMode" "ZColor" "ZDir" "ZGrid" "ZLabel" "ZLim" "ZLimMode" "ZScale" "ZTick" "ZTickLabel" "ZTickLabelMode" "ZTickMode")) ("figure" . ("BackingStore" "CloseRequestFcn" "Color" "Colormap" "CurrentAxes" "CurrentCharacter" "CurrentObject" "CurrentPoint" "Dithermap" "DithermapMode" "FixedColors" "IntegerHandle" "InvertHardcopy" "KeyPressFcn" "MenuBar" "MinColormap" "Name" "NextPlot" "NumberTitle" "PaperUnits" "PaperOrientation" "PaperPosition" "PaperPositionMode" "PaperSize" "PaperType" "Pointer" "PointerShapeCData" "PointerShapeHotSpot" "Position" "Renderer" "RendererMode" "Resize" "ResizeFcn" "SelectionType" "ShareColors" "Units" "WindowButtonDownFcn" "WindowButtonMotionFcn" "WindowButtonUpFcn" "WindowStyle")) ("image" . ("CData" "CDataMapping" "EraseMode" "XData" "YData")) ("light" . ("Position" "Color" "Style")) ("line" . ("Color" "EraseMode" "LineStyle" "LineWidth" "Marker" "LineSmoothing" "MarkerSize" "MarkerEdgeColor" "MarkerFaceColor" "XData" "YData" "ZData")) ("patch" . ("CData" "CDataMapping" "FaceVertexCData" "EdgeColor" "EraseMode" "FaceColor" "Faces" "LineStyle" "LineWidth" "Marker" "LineSmoothing" "MarkerEdgeColor" "MarkerFaceColor" "MarkerSize" "Vertices" "XData" "YData" "ZData" "FaceLighting" "EdgeLighting" "BackFaceLighting" "AmbientStrength" "DiffuseStrength" "SpecularStrength" "SpecularExponent" "SpecularColorReflectance" "VertexNormals" "NormalMode")) ("surface" . ("CData" "CDataMapping" "EdgeColor" "EraseMode" "FaceColor" "LineStyle" "LineWidth" "Marker" "MarkerEdgeColor" "LineSmoothing" "MarkerFaceColor" "MarkerSize" "MeshStyle" "XData" "YData" "ZData" "FaceLighting" "EdgeLighting" "BackFaceLighting" "AmbientStrength" "DiffuseStrength" "SpecularStrength" "SpecularExponent" "SpecularColorReflectance" "VertexNormals" "NormalMode")) ("text\\|title\\|xlabel\\|ylabel\\|zlabel" . ("Color" "EraseMode" "Editing" "Extent" "FontAngle" "FontName" "FontSize" "FontUnits" "FontWeight" "HorizontalAlignment" "BackgroundColor" "EdgeColor" "Margin" "Position" "Rotation" "String" "Units" "Interpreter" "VerticalAlignment")) ("uicontextmenu" . ("Callback")) ("uicontrol" . ("BackgroundColor" "Callback" "CData" "Enable" "Extent" "FontAngle" "FontName" "FontSize" "FontUnits" "FontWeight" "ForegroundColor" "HorizontalAlignment" "ListboxTop" "Max" "Min" "Position" "String" "Style" "SliderStep" "TooltipString" "Units" "Value")) ("uimenu" . ("Accelerator" "Callback" "Checked" "Enable" "ForegroundColor" "Label" "Position" "Separator")) ;; Flesh this out more later. ("uipushtool\\|uitoggletool\\|uitoolbar" . ("Cdata" "Callback" "Separator" "Visible")) ) "List of property lists on a per object type basis.") (defvar matlab-unknown-type-commands "[gs]et\\|findobj\\|waitfor" "Expression for commands that have unknown types.") (defun matlab-all-known-properties () "Return a list of all properties." (let ((lst matlab-core-properties) (tl matlab-property-lists)) (while tl (setq lst (append lst (cdr (car tl))) tl (cdr tl))) (matlab-uniquafy-list lst))) (defvar matlab-all-known-properties (matlab-all-known-properties) "List of all the known properties.") (defmacro matlab-property-function () "Regexp of all builtin functions that take property lists." '(let ((r matlab-unknown-type-commands) (tl matlab-property-lists)) (while tl (setq r (concat r "\\|" (car (car tl))) tl (cdr tl))) r)) ;;; Navigation =============================================================== (defvar matlab-scan-on-screen-only nil "When this is set to non-nil, then forward/backward sexp stops off screen. This is so the block highlighter doesn't gobble up lots of time when a block is not terminated.") (defun matlab-backward-sexp (&optional autoend noerror) "Go backwards one balanced set of MATLAB expressions. If optional AUTOEND, then pretend we are at an end. If optional NOERROR, then we return t on success, and nil on failure. This assumes that expressions do not cross \"function\" at the left margin." (interactive "P") (matlab-navigation-syntax (if (and (not autoend) (save-excursion (backward-word 1) (or (not (and (looking-at (matlab-block-end-no-function-re)) (matlab-valid-end-construct-p))) (matlab-cursor-in-string-or-comment)))) ;; Go backwards one simple expression (forward-sexp -1) ;; otherwise go backwards recursively across balanced expressions ;; backup over our end (if (not autoend) (forward-word -1)) (let ((done nil) (start (point)) (returnme t) (bound nil)) (when (search-backward "\nfunction" nil t) (if (progn (forward-char 9) (looking-at "\\b")) (setq bound (- (point) 8))) (goto-char start)) (while (and (not done) (or (not matlab-scan-on-screen-only) (pos-visible-in-window-p))) (if (re-search-backward (matlab-block-scan-re) bound t) (progn (goto-char (match-beginning 2)) (if (looking-at (matlab-block-end-no-function-re)) (if (or (matlab-cursor-in-string-or-comment) (not (matlab-valid-end-construct-p))) nil ;; we must skip the expression and keep searching (forward-word 1) (matlab-backward-sexp)) (if (not (matlab-cursor-in-string-or-comment)) (setq done t)))) (goto-char start) (if noerror (setq returnme nil) (error "Unstarted END construct")))) returnme)))) (defun matlab-forward-sexp (&optional includeelse) "Go forward one balanced set of MATLAB expressions. Optional argument INCLUDEELSE will stop on ELSE if it matches the starting IF." (interactive "P") (let (p) ;; go to here if no error. (save-excursion ;; don't go anywhere if there is an error (matlab-navigation-syntax ;; skip over preceeding whitespace (skip-chars-forward " \t\n;") (if (or (not (looking-at (concat "\\(" (matlab-block-beg-pre) "\\|" (matlab-block-mid-re) "\\)\\>"))) (matlab-cursor-in-string-or-comment)) ;; Go forwards one simple expression (forward-sexp 1) ;; otherwise go forwards recursively across balanced expressions (forward-word 1) (let ((done nil) (s nil) (expr-scan (if includeelse (matlab-block-re) (matlab-block-scan-re))) (expr-look (matlab-block-beg-pre))) (while (and (not done) (setq s (re-search-forward expr-scan nil t)) (or (not matlab-scan-on-screen-only) (pos-visible-in-window-p))) (goto-char (match-beginning 2)) (if (looking-at expr-look) (if (matlab-cursor-in-string-or-comment) (forward-word 1) ;; we must skip the expression and keep searching ;; NEVER EVER call with value of INCLUDEELSE (matlab-forward-sexp)) (forward-word 1) (if (and (not (matlab-cursor-in-string-or-comment)) (matlab-valid-end-construct-p)) (setq done t)))) (if (not s) (error "Unterminated block")))) (setq p (point)))) ;; really go here (goto-char p))) (defun matlab-indent-sexp () "Indent the syntactic block starting at point." (interactive) (indent-region (point) (save-excursion (matlab-forward-sexp) (point)) nil)) (defun matlab-beginning-of-enclosing-defun () "Move cursor to beginning of enclosing function. If `matlab-functions-have-end', skip over functions with end." (catch 'done (let ((start (point)) (beg nil)) (while (re-search-backward matlab-defun-regex nil t) (setq beg (point)) (condition-case nil (progn (matlab-forward-sexp) (if (> (point) start) (throw 'done beg))) (error (throw 'done beg))) (goto-char beg))) nil)) (defun matlab-beginning-of-defun () "Go to the beginning of the current function." (interactive) (if matlab-functions-have-end (goto-char (or (matlab-beginning-of-enclosing-defun) (point-min))) (or (re-search-backward matlab-defun-regex nil t) (goto-char (point-min))))) (defun matlab-end-of-defun () "Go to the end of the current function." (interactive) (or (progn (if (looking-at matlab-defun-regex) (goto-char (match-end 0))) (if (re-search-forward matlab-defun-regex nil t) (progn (forward-line -1) t))) (goto-char (point-max)))) (defun matlab-current-defun () "Return the name of the current function." (save-excursion (matlab-beginning-of-defun) (if (looking-at (matlab-match-function-re)) (progn (goto-char (match-end 0)) (current-word))))) (defun matlab-beginning-of-command () "Go to the beginning of an M command. Travels across continuations." (interactive) (beginning-of-line) (let ((p nil) ;; This restriction is a wild guess where to end reverse ;; searching for array continuations. The reason is that ;; matlab up list is very slow, and most people would never ;; put a blank line in a matrix. Either way, it's worth the ;; trade off to speed this up for large files. ;; This list of keywords is NOT meant to be comprehensive. (r (save-excursion (re-search-backward "^\\s-*\\(%\\|if\\|else\\(if\\)\\|while\\|\\(par\\)?for\\|$\\)\\>" nil t)))) (while (and (or (save-excursion (and (matlab-prev-line) (matlab-lattr-cont))) (matlab-ltype-continued-comm) (setq p (matlab-lattr-array-cont r))) (save-excursion (beginning-of-line) (not (bobp)))) (if p (goto-char p) (matlab-prev-line)) (setq p nil)) (back-to-indentation))) (defun matlab-end-of-command (&optional beginning) "Go to the end of an M command. Optional BEGINNING is where the command starts from." (interactive) (while (and (or (matlab-lattr-cont) (save-excursion (forward-line 1) (or (matlab-ltype-continued-comm) (matlab-lattr-array-cont beginning)))) ;; This hack is a short circuit. If a user did not ;; correctly end a matrix, this will short-circuit ;; as soon as somethng that would never appear in a matrix ;; becomes visible. (not (save-excursion (beginning-of-line) (looking-at (matlab-block-scan-re)))) ;; If we hit the end of the buffer unexpectedly, this test ;; will fail and we'll avoid looping forever. (E.g., this ;; is triggered if a continuation line is the last one in ;; the buffer, and the line lacks the final newline.) (zerop (forward-line 1)))) (end-of-line)) ;;; Line types and attributes ================================================= (defun matlab-ltype-empty () ; blank line "Return t if current line is empty." (save-excursion (beginning-of-line) (looking-at "^[ \t]*$"))) (defun matlab-ltype-comm () ; comment line "Return t if current line is a MATLAB comment line. Return the symbol 'cellstart if it is a double %%. Return the symbol 'blockcomm if it is a block comment start." (save-excursion (beginning-of-line) (cond ((looking-at "[ \t]*%\\([^%]\\|$\\)") t) ((looking-at "[ \t]*%%") 'cellstart) ((matlab-ltype-block-comm) 'blockcomm) (t nil)))) (defun matlab-ltype-comm-ignore () ; comment out a region line "Return t if current line is a MATLAB comment region line." (save-excursion (beginning-of-line) (looking-at (concat "[ \t]*" matlab-comment-region-s)))) (defun matlab-ltype-help-comm () "Return t if the current line is part of the MATLAB help comment." (save-excursion (if (not (matlab-ltype-comm)) nil (while (and (matlab-ltype-comm) (not (bobp)) (matlab-prev-line)) (beginning-of-line)) (matlab-ltype-function-definition)))) (defun matlab-ltype-block-comm () "Return t if we are in a block comment." (save-excursion (if (looking-at "%{") t (when (re-search-backward "\\%\\([{}]\\)" nil t) (let ((ms (match-string 1))) (if (string= ms "{") t nil)))))) (defun matlab-ltype-endfunction-comm () "Return t if the current line is an ENDFUNCTION style comment." (save-excursion (if (not (matlab-ltype-comm)) nil (beginning-of-line) (if (looking-at "^[ \t]*%[ \t]*endfunction") t (while (and (or (matlab-ltype-comm) (matlab-ltype-empty)) (not (eobp))) (forward-line 1)) (and (matlab-ltype-function-definition) (not (save-excursion (matlab-beginning-of-enclosing-defun)))) )))) (defun matlab-ltype-continued-comm () "Return column of previous line's comment start, or nil." (save-excursion (beginning-of-line) (let ((commtype (matlab-ltype-comm))) (if (or (eq commtype 'cellstart) ;; Cells are not continuations from previous comments. (null commtype) (bobp)) nil ;; We use forward-line and not matlab-prev-line because ;; we want blank lines to terminate this indentation method. (forward-line -1) (let ((col (matlab-lattr-comm))) (if col (progn (goto-char col) (current-column)) nil)))))) (defun matlab-ltype-function-definition () "Return t if the current line is a function definition." (save-excursion (beginning-of-line) (looking-at matlab-defun-regex))) (defun matlab-ltype-code () ; line of code "Return t if current line is a MATLAB code line." (and (not (matlab-ltype-empty)) (not (matlab-ltype-comm)))) (defun matlab-lattr-comm () ; line has comment "Return t if current line contain a comment." (save-excursion (matlab-comment-on-line))) (defun matlab-lattr-implied-continuation () "Return non-nil if this line has implied continuation on the next. This is only useful for new versions of MATLAB where ... is optional." (when (not (matlab-lattr-comm)) (let ((imp nil)) (save-excursion (end-of-line) (skip-chars-backward " \t") ;; Test for oporator incompleteness. (setq imp (/= (point) ;; Careful, - means range in this expression. (progn (skip-chars-backward "-+=/*.^&~<>") (point)))) (if (not imp) ;; Test for argument list incompleteness (condition-case nil (progn (end-of-line) (matlab-up-list -1) (setq imp (looking-at "("))) (error nil))) ) imp))) (defun matlab-lattr-cont () ; line has continuation "Return non-nil if current line ends in ... and optional comment. If `matlab-cont-requires-ellipsis' is nil, then we need to apply a heuristic to determine if this line would use continuation based on what it ends with." (save-excursion (beginning-of-line) (or ;; Here, if the line ends in ..., then it is what we are supposed to do. (and (re-search-forward "[^ \t.][ \t]*\\.\\.+[ \t]*\\(%.*\\)?$" (matlab-point-at-eol) t) (progn (goto-char (match-beginning 0)) (not (matlab-cursor-in-comment)))) ;; If the line doesn't end in ..., but we have optional ..., then ;; use this annoying heuristic. (and (null matlab-cont-requires-ellipsis) (matlab-lattr-implied-continuation)) ))) (defun matlab-lattr-array-cont (&optional restrict) "Return non-nil if current line is in an array. If the entirety of the array is on this line, return nil. Optional option RESTRICT is the distrance to restrict the search." (condition-case nil (save-excursion (beginning-of-line) (matlab-up-list -1 restrict) (and (looking-at "[[{]") (point))) (error nil))) (defun matlab-lattr-array-end () "Return non-nil if the current line closes an array. by close, the first character is the end of an array." (save-excursion (back-to-indentation) (and (looking-at "[]}]") (matlab-lattr-array-cont)))) (defun matlab-lattr-block-cont (&optional eol) "Return a number representing the number of unterminated block constructs. This is any block, such as if or for, that doesn't have an END on this line. Optional EOL indicates a virtual end of line." (let ((v 0)) (save-excursion (beginning-of-line) (save-restriction (narrow-to-region (point) (or eol (matlab-point-at-eol))) (matlab-navigation-syntax (while (re-search-forward (concat "\\<" (matlab-block-beg-re) "\\>") nil t) (if (matlab-cursor-in-string-or-comment) ;; Do nothing nil ;; Increment counter, move to end. (setq v (1+ v)) (let ((p (point))) (forward-word -1) (condition-case nil (progn (matlab-forward-sexp) (setq v (1- v))) (error (goto-char p)))))) v))))) (defun matlab-lattr-middle-block-cont () "Return the number of middle block continuations. This should be 1 or nil, and only true if the line starts with one of these special items." (save-excursion (back-to-indentation) (if (looking-at (concat (matlab-block-mid-re) "\\>")) (if (and (re-search-forward (matlab-block-end-pre) (matlab-point-at-eol) t) (matlab-valid-end-construct-p)) ;; If there is an END, we still need to return non-nil, ;; but the number value is a net of 0. 0 1) nil))) (defun matlab-lattr-endless-block-cont () "Return the number of middle block continuations. This should be 1 or nil, and only true if the line starts with one of these special items." (save-excursion (back-to-indentation) (if (looking-at (concat (matlab-endless-blocks-re) "\\>")) 1 nil))) (defun matlab-lattr-block-close (&optional start) "Return the number of closing block constructs. Argument START is where to start searching from." (let ((v 0)) (save-excursion (when start (goto-char start)) (save-restriction (narrow-to-region (save-excursion (matlab-beginning-of-command) (point)) (matlab-point-at-eol)) (goto-char (point-max)) (while (and (re-search-backward (concat "\\<" (matlab-block-end-re) "\\>") nil t) (not (matlab-cursor-in-string-or-comment)) (matlab-valid-end-construct-p)) (setq v (1+ v)) (let ((startmove (match-end 0)) (nomove (point))) (condition-case nil (progn (matlab-backward-sexp t) (setq v (1- v))) (error (goto-char nomove))) )) ;; If we can't scoot back, do a cheat-test to see if there ;; is a matching else or elseif. (goto-char (point-min)) (back-to-indentation) (if (looking-at (matlab-block-mid-re)) (setq v (1- v))) ;; Return nil, or a number (if (<= v 0) nil v))))) (defun matlab-lattr-local-end () "Return t if this line begins with an end construct." (save-excursion (back-to-indentation) (and (looking-at (concat "\\<" (matlab-block-end-re) "\\>")) (matlab-valid-end-construct-p)))) (defun matlab-lattr-semantics (&optional prefix) "Return the semantics of the current position. Values are nil 'solo, 'value, and 'boolean. Boolean is a subset of value. nil means there is no semantic content (ie, string or comment.) If optional PREFIX, then return 'solo if that is the only thing on the line." (cond ;((matlab-cursor-in-string-or-comment) ;nil) ((or (matlab-ltype-empty) (and prefix (save-excursion (beginning-of-line) (looking-at (concat "\\s-*" prefix "\\s-*$"))))) 'solo) ((save-excursion (matlab-beginning-of-command) (looking-at "\\s-*\\(if\\|elseif\\|while\\)\\>")) 'boolean) ((save-excursion (matlab-beginning-of-command) (looking-at (concat "\\s-*\\(" (matlab-property-function) "\\)\\>"))) 'property) (t 'value))) (defun matlab-function-called-at-point () "Return a string representing the function called nearby point." (save-excursion (beginning-of-line) (cond ((looking-at "\\s-*\\([a-zA-Z]\\w+\\)[^=][^=]") (match-string 1)) ((and (re-search-forward "=" (matlab-point-at-eol) t) (looking-at "\\s-*\\([a-zA-Z]\\w+\\)\\s-*[^=]")) (match-string 1)) (t nil)))) (defun matlab-cursor-in-string-or-comment () "Return t if the cursor is in a valid MATLAB comment or string." ;; comment and string depend on each other. Here is one test ;; that does both. (save-restriction (narrow-to-region (matlab-point-at-bol) (matlab-point-at-eol)) (let ((p (1+ (point))) (returnme nil) (sregex (concat matlab-string-start-regexp "'"))) (save-excursion (goto-char (point-min)) (while (and (re-search-forward (concat "'\\|%\\|" (regexp-quote matlab-elipsis-string)) nil t) (<= (point) p)) (if (or (= ?% (preceding-char)) (= ?. (preceding-char))) ;; Here we are in a comment for the rest of it. (progn (goto-char p) (setq returnme t)) ;; Here, we could be a string start, or transpose... (if (or (= (current-column) 1) (save-excursion (forward-char -2) (looking-at sregex))) ;; a valid string start, find the end (let ((f (re-search-forward matlab-string-end-regexp nil t))) (if f (setq returnme (> (point) p)) (setq returnme t))) ;; Ooops, a transpose, keep going. )))) returnme))) (defun matlab-cursor-in-comment () "Return t if the cursor is in a valid MATLAB comment." (save-match-data (save-restriction (narrow-to-region (matlab-point-at-bol) (matlab-point-at-eol)) (save-excursion (let ((prev-match nil)) (while (and (re-search-backward (concat "%\\|" (regexp-quote matlab-elipsis-string) "+") nil t) (not (matlab-cursor-in-string))) (setq prev-match (point))) (if (and prev-match (matlab-cursor-in-string)) (goto-char prev-match)) (and (looking-at (concat "%\\|" (regexp-quote matlab-elipsis-string))) (not (matlab-cursor-in-string)))))))) (defun matlab-cursor-in-string (&optional incomplete) "Return t if the cursor is in a valid MATLAB string. If the optional argument INCOMPLETE is non-nil, then return t if we are in what could be a an incomplete string." (let ((m (match-data)) (returnme nil)) (save-restriction (narrow-to-region (matlab-point-at-bol) (matlab-point-at-eol)) (let ((p (1+ (point))) (sregex (concat matlab-string-start-regexp "'")) (instring nil)) (save-excursion ;; Comment hunters need strings to not call the comment ;; identifiers. Thus, this routines must be savvy of comments ;; without recursing to them. (goto-char (point-min)) (while (or (and instring (looking-at "'")) (and (re-search-forward (concat "'\\|%\\|" (regexp-quote matlab-elipsis-string)) nil t) (<= (point) p) ;; Short circuit to fix this. (progn (setq instring nil) t))) ;; The next line emulates re-search-foward (if instring (goto-char (match-end 0))) (if (or (= ?% (preceding-char)) (= ?. (preceding-char))) ;; Here we are in a comment for the rest of it. ;; thus returnme is a force-false. (goto-char p) ;; Here, we could be in a string start, or transpose... (if (or (= (current-column) 1) instring (save-excursion (forward-char -2) (looking-at sregex))) ;; a valid string start, find the end (let ((f (re-search-forward matlab-string-end-regexp nil t))) (if (and (not f) incomplete) (setq returnme t) (setq returnme (> (point) p)) (setq instring t))) ;; Ooops, a transpose, keep going. )))))) (set-match-data m) returnme)) (defun matlab-comment-on-line () "Place the cursor on the beginning of a valid comment on this line. If there isn't one, then return nil, point otherwise." (interactive) (let ((eol (matlab-point-at-eol)) (p (point)) (signal-error-on-buffer-boundary nil)) (beginning-of-line) (while (and (re-search-forward "%" eol t) (save-excursion (forward-char -1) (matlab-cursor-in-string t)))) (if (not (bolp)) (forward-char -1)) (if (and (looking-at "%") (not (matlab-cursor-in-string t))) (point) (goto-char p) nil))) ;;; Indent functions ========================================================== (defun matlab-indent-line () "Indent a line in `matlab-mode'." (interactive) (let ((i (matlab-calc-indent)) (c (current-column))) (save-excursion (back-to-indentation) (if (= i (current-column)) nil (beginning-of-line) (delete-horizontal-space) (indent-to i)) ;; If line contains a comment, format it. (if () (if (matlab-lattr-comm) (matlab-comment)))) (if (<= c i) (move-to-column i)))) (defun matlab-calc-indent () "Return the appropriate indentation for this line as an integer." (interactive) ;; The first step is to find the current indentation. ;; This is defined to be zero if all previous lines are empty. (let* ((ci (save-excursion (if (not (matlab-prev-line)) 0 (matlab-next-line-indentation)))) (sem (matlab-calculate-indentation ci))) ;; simplistic (nth 1 sem))) (defconst matlab-functions-have-end-should-be-true "This end closes a function definition.\nDo you want functions to have ends? " "Prompt the user about whether to change matlab-functions-have-end") (defun matlab-calculate-indentation (current-indentation) "Calculate out the indentation of the current line. Return a list of descriptions for this line. Return format is: '(TYPE DEPTHNUMBER) where TYPE is one of (comment, code, function, blockstart, blockmid, blockendless, blockend) DEPTHNUMBER is how many characters to indent this line. Argument CURRENT-INDENTATION is what the previous line thinks this line's indentation should be. See `matlab-next-line-indentation'." (matlab-navigation-syntax (matlab-calculate-indentation-1 current-indentation))) (defun matlab-calculate-indentation-1 (current-indentation) "Do the indentation work of `matlab-calculate-indentation'. Argument CURRENT-INDENTATION is what the previous line recommends for indentation." (let ((ci current-indentation) (tmp nil)) (cond ;; COMMENTS ((matlab-ltype-comm) (cond ;; HELP COMMENT and COMMENT REGION ((or (matlab-ltype-help-comm) (matlab-ltype-comm-ignore)) (list 'comment-help (save-excursion (matlab-beginning-of-defun) (current-indentation)))) ;; COMMENT Continued From Previous Line ((setq tmp (matlab-ltype-continued-comm)) (list 'comment tmp)) ;; END FUNCTION COMMENT ((matlab-ltype-endfunction-comm) (list 'comment-endfunction 0)) (t (list 'comment (+ ci matlab-comment-anti-indent))))) ;; FUNCTION DEFINITION ((matlab-ltype-function-definition) (if matlab-functions-have-end ;; A function line has intrinsic indentation iff function bodies are ;; not indented and the function line is nested within another function. (if (and (not (matlab-indent-function-body-p)) (save-excursion (beginning-of-line) (matlab-beginning-of-enclosing-defun))) (setq ci (+ ci matlab-indent-level)) ;; If no intrinsic indentation, do not change from ci. ) ;; If functions are not nested, functions go to left margin. (setq ci 0)) (list 'function ci)) ;; END keyword ((matlab-lattr-local-end) (let ((end-of-function (let ((matlab-functions-have-end t)) (save-excursion (beginning-of-line) (matlab-backward-sexp t) ;; may throw "unstarted block" error (matlab-ltype-function-definition))))) (if end-of-function (if (or matlab-functions-have-end (if (yes-or-no-p matlab-functions-have-end-should-be-true) ;; TODO - ask user to reindent the fcn now? (setq matlab-functions-have-end t) (error "Unmatched end"))) (if (matlab-indent-function-body-p) (setq ci (- ci matlab-indent-level)))) ;; Next, see if this line starts with an end, and whether the ;; end is matched, and whether the line is blank up to the match. ;; If so, return the indentation of the match. (catch 'indent (save-excursion (when (progn (beginning-of-line) (and (looking-at "[ \t]*end\\b") (matlab-backward-sexp t t))) (let ((match (point))) (beginning-of-line) (looking-at "[ \t]*") (when (= match (match-end 0)) (setq ci (- match (match-beginning 0))) (throw 'indent nil))))) ;; End of special case for end and match after "^[ \t]*". (setq ci (+ ci (* (1- (matlab-lattr-block-cont (point))) matlab-indent-level)))))) (list 'blockend ci)) ;; ELSE/CATCH keywords ((matlab-lattr-middle-block-cont) (let ((m (match-string 1))) (list 'blockmid (condition-case nil (save-excursion (beginning-of-line) (matlab-backward-sexp t) (if (matlab-ltype-function-definition) (error "")) (current-column)) (error (error "Unmatched %s" m)))))) ;; CASE/OTHERWISE keywords ((matlab-lattr-endless-block-cont) (list 'blockendless (condition-case nil (save-excursion (beginning-of-line) (matlab-backward-sexp t) (if (not (looking-at "switch\\>")) (error "")) (+ (current-column) (if (listp matlab-case-level) (car matlab-case-level) matlab-case-level))) (error (error "Unmatched case/otherwise part"))))) ;; End of a MATRIX ((matlab-lattr-array-end) (list 'array-end (save-excursion (back-to-indentation) (matlab-up-list -1) (let* ((fc (following-char)) (mi (assoc fc matlab-maximum-indents)) (max (if mi (if (listp (cdr mi)) (car (cdr mi)) (cdr mi)) nil)) (ind (if mi (if (listp (cdr mi)) (cdr (cdr mi)) (cdr mi)) nil))) ;; apply the maximum limits. (if (and ind (> (- (current-column) ci) max)) (1- ind) ; decor (current-column)))))) ;; Code lines ((save-excursion (beginning-of-line) (back-to-indentation) (= (point) (progn (matlab-beginning-of-command) (point)))) ;; This means we are at the beginning of a command structure. ;; Always match up against the previous line. (list 'code ci)) ;; Lines continued from previous statements. (t (list (if (matlab-ltype-empty) 'empty (if (matlab-lattr-array-cont) 'array-cont 'code)) (condition-case nil ;; Line up with opening paren/brace/bracket (let ((boc (save-excursion (matlab-beginning-of-command) (point)))) (save-excursion (beginning-of-line) (matlab-up-list -1) (if (> boc (point)) (error nil)) ;; Ok, it MIGHT be that we are in a program ;; statement, and this particular command is an HG ;; statement that would look better if the ;; following lines lined up AFTER the first ;; argument. Lets look. (let ((parendepth (current-column))) (cond ((and (= (following-char) ?\( ) (save-excursion (matlab-navigation-syntax (forward-word -1) (looking-at matlab-indent-past-arg1-functions))) (let ((start-paren (point))) (while (and (re-search-forward "," (matlab-point-at-eol) t) (save-excursion (matlab-up-list -1) (> (point) start-paren)))) (if (and (= (preceding-char) ?,) ;; Don't bother if we hit the EOL. (not (looking-at "\\s-*\\(\\.\\.\\.\\|$\\|)\\)"))) t (move-to-column parendepth) nil))) (skip-chars-forward " \t") (if (> (- (current-column) parendepth) matlab-arg1-max-indent-length) (+ parendepth matlab-arg1-max-indent-length) (current-column))) (t (let* ((fc (following-char)) (mi (assoc fc matlab-maximum-indents)) (max (if mi (if (listp (cdr mi)) (car (cdr mi)) (cdr mi)) nil)) (ind (if mi (if (listp (cdr mi)) (cdr (cdr mi)) (cdr mi)) nil))) (forward-char 1) (skip-chars-forward " \t") ;; If we are at the end of a line and ;; this open paren is there, then we ;; DONT want to indent to it. Use the ;; standard indent. (if (looking-at "\\.\\.\\.\\|$") ;; This could happen in another set ;; of matricies. Find a current ;; indentation based on the ;; previous line. (let ((cci (current-indentation))) (+ cci matlab-cont-level)) ;; apply the maximum limits. (if (and ind (> (- (current-column) ci) max)) (+ ci ind) (current-column))))))))) (error ;; Line up to an equals sign. (save-excursion (matlab-beginning-of-command) (while (and (re-search-forward "=" (matlab-point-at-eol) t) (matlab-cursor-in-string-or-comment))) (if (/= (preceding-char) ?=) (+ ci matlab-cont-level) (skip-chars-forward " \t") (let ((cc (current-column)) (mi (assoc ?= matlab-maximum-indents))) (if (looking-at "\\.\\.\\.\\|$") ;; In this case, the user obviously wants the ;; indentation to be somewhere else. (+ ci (cdr (cdr mi))) ;; If the indent delta is greater than the max, ;; use the max + currenti (if (and mi (> (- cc ci) (if (listp (cdr mi)) (car (cdr mi)) (cdr mi)))) (setq cc (+ ci (if (listp (cdr mi)) (cdr (cdr mi)) (cdr mi))))) cc)))))))) ))) (defun matlab-next-line-indentation () "Calculate the indentation for lines following this command line. Assume that the following line does not contribute its own indentation \(as it does in the case of nested functions in the following situations): o function---positive indentation when not indenting function bodies. o end---negative indentation except when the 'end' matches a function and not indenting function bodies. See `matlab-calculate-indentation'." (matlab-navigation-syntax (let ((startpnt (point-at-eol))) (save-excursion (matlab-beginning-of-command) (let ((cc (or (matlab-lattr-block-close startpnt) 0)) (end (matlab-lattr-local-end)) (bc (matlab-lattr-block-cont startpnt)) (mc (matlab-lattr-middle-block-cont)) (ec (matlab-lattr-endless-block-cont)) (hc (and (matlab-indent-function-body-p) (matlab-ltype-help-comm))) (rc (and (/= 0 matlab-comment-anti-indent) (matlab-ltype-comm) (not (matlab-ltype-help-comm)) (not (matlab-ltype-continued-comm)) (not (matlab-ltype-endfunction-comm)))) (ci (current-indentation))) ;; When the current point is on a line with a function, the value of bc will ;; reflect the function in a block count iff if matlab-functions-have-end is ;; true. However, if matlab-indent-function-body-p is false, there should be ;; no actual indentation, so bc needs to be decremented by 1. Similarly, if ;; on a line with an end that closes a function, bc needs to be decremented ;; by 1 if matlab-functions-have-end is true and matlab-indent-function-body-p ;; is false. However, just to be safe, indentation is not allowed to go ;; negative. Thus: (if matlab-functions-have-end (if (and (not (matlab-indent-function-body-p)) (or (matlab-ltype-function-definition) (and (matlab-lattr-local-end) (save-excursion (matlab-backward-sexp t) (looking-at "function\\b"))))) (if (> bc 0) (setq bc (1- bc)) (if (>= ci matlab-indent-level) (setq bc -1)))) (if (and (matlab-indent-function-body-p) (matlab-ltype-function-definition)) (setq bc (1+ bc)))) ;; Remove 1 from the close count if there is an END on the beginning ;; of this line, since in that case, the unindent has already happened. (when end (setq cc (1- cc))) ;; Calculate the suggested indentation. (+ ci (* matlab-indent-level bc) (* matlab-indent-level (or mc 0)) (* matlab-indent-level (- cc)) (* (if (listp matlab-case-level) (cdr matlab-case-level) matlab-case-level) (or ec 0)) (if hc matlab-indent-level 0) (if rc (- 0 matlab-comment-anti-indent) 0) )))))) ;;; The return key ============================================================ (defcustom matlab-return-function 'matlab-indent-end-before-ret "Function to handle return key. Must be one of: 'matlab-plain-ret 'matlab-indent-after-ret 'matlab-indent-end-before-ret 'matlab-indent-before-ret" :group 'matlab :type '(choice (function-item matlab-plain-ret) (function-item matlab-indent-after-ret) (function-item matlab-indent-end-before-ret) (function-item matlab-indent-before-ret))) (defun matlab-return () "Handle carriage return in `matlab-mode'." (interactive) (matlab-semicolon-on-return) (funcall matlab-return-function)) (defun matlab-plain-ret () "Vanilla new line." (interactive) (newline)) (defun matlab-indent-after-ret () "Indent after new line." (interactive) (newline) (matlab-indent-line)) (defun matlab-indent-end-before-ret () "Indent line if block end, start new line, and indent again." (interactive) (if (save-excursion (beginning-of-line) (looking-at (concat "^\\s-*\\(" (matlab-block-end-re) "\\|" (matlab-block-mid-re) "\\|" (matlab-endless-blocks-re) "\\|function\\)"))) (matlab-indent-line)) (newline) (matlab-indent-line)) (defun matlab-semicolon-on-return () "If needed, add a semicolon at point automatically." (if matlab-return-add-semicolon (if (and (not (matlab-ltype-empty)) (not (save-excursion (skip-chars-backward " \t;" (matlab-point-at-bol)) (looking-at "\\s-*;"))) (save-excursion (let ((p (point))) (matlab-end-of-command (point)) (eq p (point)))) (save-excursion (matlab-beginning-of-command) ;; Note: Compile warning below, but defined later. (not (looking-at matlab-quiesce-nosemi-regexp)))) (insert ";")) )) (defun matlab-indent-before-ret () "Indent line, start new line, and indent again." (interactive) (matlab-indent-line) (newline) (matlab-indent-line)) (defun matlab-linefeed () "Handle line feed in `matlab-mode'. Has effect of `matlab-return' with (not matlab-indent-before-return)." (interactive) (matlab-indent-line) (newline) (matlab-indent-line)) (defun matlab-comment-return () "Handle carriage return for MATLAB comment line." (interactive) (cond ((matlab-ltype-comm) (matlab-set-comm-fill-prefix) (newline) (insert fill-prefix) (matlab-reset-fill-prefix) (matlab-indent-line)) ((matlab-lattr-comm) (newline) (indent-to comment-column) (insert matlab-comment-on-line-s)) (t (newline) (matlab-comment) (matlab-indent-line)))) (defun matlab-comm-from-prev () "If the previous line is a comment-line then set up a comment on this line." (save-excursion ;; If the previous line is a comment-line then set the fill prefix from ;; the previous line and fill this line. (if (and (= 0 (forward-line -1)) (matlab-ltype-comm)) (progn (matlab-set-comm-fill-prefix) (forward-line 1) (beginning-of-line) (delete-horizontal-space) (if (looking-at "%") (delete-char 1)) (delete-horizontal-space) (insert fill-prefix) (matlab-reset-fill-prefix))))) (defun matlab-electric-comment (arg) "Indent line and insert comment character. Argument ARG specifies how many %s to insert." (interactive "P") (self-insert-command (or arg 1)) (when (matlab-ltype-comm) (matlab-indent-line) ;; The above seems to put the cursor on the %, not after it. (skip-chars-forward "%"))) ;;; Comment management======================================================== (defun matlab-comment () "Add a comment to the current line." (interactive) (cond ((matlab-ltype-empty) ; empty line (matlab-comm-from-prev) (if (matlab-lattr-comm) (skip-chars-forward " \t%") (insert matlab-comment-line-s) (matlab-indent-line))) ((matlab-ltype-comm) ; comment line (matlab-comm-from-prev) (skip-chars-forward " \t%")) ((matlab-lattr-comm) ; code line w/ comment (beginning-of-line) (re-search-forward "[^%]%[ \t]") (forward-char -2) (if (> (current-column) comment-column) (delete-horizontal-space)) (if (< (current-column) comment-column) (indent-to comment-column)) (skip-chars-forward "% \t")) (t ; code line w/o comment (end-of-line) (re-search-backward "[^ \t\n^]" 0 t) (forward-char) (delete-horizontal-space) (if (< (current-column) comment-column) (indent-to comment-column) (insert " ")) (insert matlab-comment-on-line-s)))) (defun matlab-comment-line-break-function (&optional soft) "Break the current line, and if in a comment, continue it. Optional argument SOFT indicates that the newline is soft, and not hard." (interactive) (if (not (matlab-cursor-in-comment)) (matlab-return) ;; Will the below fn work in old emacsen? (if soft (insert-and-inherit ?\n) (newline 1)) (insert "% ") (matlab-indent-line) (end-of-line))) (defun matlab-comment-indent () "Indent a comment line in `matlab-mode'." (matlab-calc-indent)) (defun matlab-comment-region (beg-region end-region arg) "Comments every line in the region. Puts `matlab-comment-region-s' at the beginning of every line in the region. BEG-REGION and END-REGION are arguments which specify the region boundaries. With non-nil ARG, uncomments the region." (interactive "*r\nP") (let ((end-region-mark (make-marker)) (save-point (point-marker))) (set-marker end-region-mark end-region) (goto-char beg-region) (beginning-of-line) (if (not arg) ;comment the region (progn (insert matlab-comment-region-s) (while (and (= (forward-line 1) 0) (< (point) end-region-mark)) (insert matlab-comment-region-s))) (let ((com (regexp-quote matlab-comment-region-s))) ;uncomment the region (if (looking-at com) (delete-region (point) (match-end 0))) (while (and (= (forward-line 1) 0) (< (point) end-region-mark)) (if (looking-at com) (delete-region (point) (match-end 0)))))) (goto-char save-point) (set-marker end-region-mark nil) (set-marker save-point nil))) (defun matlab-uncomment-region (beg end) "Uncomment the current region if it is commented out. Argument BEG and END indicate the region to uncomment." (interactive "*r") (matlab-comment-region beg end t)) ;;; Filling =================================================================== (defun matlab-set-comm-fill-prefix () "Set the `fill-prefix' for the current (comment) line." (interactive) (if (matlab-lattr-comm) (setq fill-prefix (save-excursion (beginning-of-line) (let ((e (matlab-point-at-eol)) (pf nil)) (while (and (re-search-forward "%+[ \t]*\\($$$ \\)?" e t) (matlab-cursor-in-string))) (setq pf (match-string 0)) (concat (make-string (- (current-column) (length pf)) ? ) pf)))))) (defun matlab-set-comm-fill-prefix-post-code () "Set the `fill-prefix' for the current post-code comment line." (interactive) (matlab-set-comm-fill-prefix)) (defun matlab-reset-fill-prefix () "Reset the `fill-prefix'." (setq fill-prefix nil)) (defun matlab-find-convenient-line-break () "For the current line, position the cursor where we want to break the line. Basically, spaces are best, then operators. Always less than `fill-column' unless we decide we can fudge the numbers. Return nil if this line should not be broken. This function will ONLY work on code." ;; First of all, if this is a continuation, then the user is ;; requesting that we don't mess with his stuff. (if (matlab-lattr-cont) nil (save-restriction (narrow-to-region (matlab-point-at-bol) (matlab-point-at-eol)) ;; get ourselves onto the fill-column. (move-to-column fill-column) (let ((pos nil) (orig (point))) (or ;; Next, if we have a trailing comment, use that. (progn (setq pos (or (matlab-lattr-comm) (matlab-point-at-bol))) (goto-char pos) (if (and (> (current-column) (- fill-column matlab-fill-fudge)) (< (current-column) (+ fill-column matlab-fill-fudge))) t (goto-char orig) nil)) ;; Now, lets find the nearest space (after or before fill column) (let* ((after (save-excursion (re-search-forward "[ \t]" nil t))) (before (save-excursion (re-search-backward "[ \t]" nil t))) (afterd (- (or after (matlab-point-at-eol)) (point))) (befored (- (point) (or before (matlab-point-at-bol))))) ;; Here, if "before" is actually the beginning of our ;; indentation, then this is most obiously a bad place to ;; break our lines. (if before (save-excursion (goto-char before) (if (<= (point) (save-excursion (back-to-indentation) (point))) (setq before nil)))) (cond ((and after (< afterd matlab-fill-fudge) (< afterd befored)) (goto-char after) t) ((and before (< befored matlab-fill-fudge) (< befored afterd)) (goto-char before) t) (t (goto-char orig) nil))) ;; Now, lets find the nearest backwards (progn (re-search-backward "\\(\\s-\\|\\s.\\)+" nil t) (while (and (looking-at "\\^\\|\\.\\|'") (re-search-backward "\\(\\s-\\|\\s.\\)+" nil t))) (if (or (not (looking-at "\\(\\s-\\|\\s.\\)+")) (<= (point) (save-excursion (back-to-indentation) (point)))) (progn ;; We failed in our mission to find anything, or fell ;; of the edge of the earth. If we are out of ;; bounds, lets try again. (goto-char orig) (if (re-search-backward "\\s.+" nil t) t nil)) ;; Ok, we have a good location to break. Check for column ;; and ref against nearest list ending to predict a possibly ;; better break point. (forward-char 1) (let ((okpos (current-column)) (startlst (save-excursion (condition-case nil (matlab-up-list -1) (error nil)) (if (save-excursion (forward-char -1) (looking-at "\\w")) (forward-word -1)) (current-column))) (endlst (save-excursion (condition-case nil (matlab-up-list 1) (error nil)) (current-column)))) ;; When evaluating list fudge factores, breaking on the ;; edge of a list, or at the beginning of a function ;; call can be more valuable than breaking on a symbol ;; of a mid-sized list. As such, allow double-fudge ;; for lists. (cond ;; First, pick the end of a list. ((and (< endlst matlab-fill-fudge-hard-maximum) (<= endlst (+ fill-column matlab-fill-fudge)) (or (<= (* matlab-fill-fudge 2) (- endlst okpos)) (<= endlst fill-column)) (save-excursion (move-to-column endlst) (not (looking-at "\\^")))) (move-to-column endlst) t) ;; Else, back up over this list and poke around ((>= (* 2 matlab-fill-fudge) (- okpos startlst)) (move-to-column startlst) t) ;; Oh well, just do this symbol. (t (move-to-column okpos) t))))) ;; Well, this just sucks (progn (goto-char orig) nil)))))) (defun matlab-auto-fill () "Do auto filling. Set variable `auto-fill-function' to this symbol to enable MATLAB style auto filling which will automatically insert `...' and the end of a line." (interactive) (let ((fill-prefix fill-prefix) ;; safe way of modifying fill-prefix. (fill-column (- fill-column (if matlab-fill-count-ellipsis-flag (save-excursion (move-to-column fill-column) (if (not (bobp)) (forward-char -1)) (if (matlab-cursor-in-string 'incomplete) 4 3)) 0)))) (if (> (current-column) fill-column) (cond ((matlab-ltype-comm-ignore) nil) ((or (matlab-ltype-comm) (and (save-excursion (move-to-column fill-column) (matlab-cursor-in-comment)) (matlab-lattr-comm))) ;; If the whole line is a comment, do this. (matlab-set-comm-fill-prefix) (do-auto-fill) (matlab-reset-fill-prefix)) ((and (matlab-ltype-code) (not (matlab-lattr-cont)) matlab-fill-code) ;; If we are on a code line, we ellipsify before we fill. (let ((m (make-marker))) (move-marker m (point)) (set-marker-insertion-type m t) (if (not (matlab-find-convenient-line-break)) nil (if (not (save-excursion (forward-char -1) (matlab-cursor-in-string 'incomplete))) (progn (delete-horizontal-space) (insert " " matlab-elipsis-string "\n") (matlab-indent-line)) (if matlab-fill-strings-flag (let ((pos (point)) (pos2 nil)) (while (and (re-search-backward "'" (point-at-bol) t) (progn (forward-char -1) (looking-at "''")))) (setq pos2 (point)) ;; Check if there is already an opening bracket or if string is continued (if (or (looking-at "\\[") (save-excursion (skip-chars-backward " \t") (forward-char -1) (looking-at "\\[")) (progn (beginning-of-line) (skip-chars-backward (concat " \t\n" matlab-elipsis-string)) (if (> (point) (point-min)) (progn (forward-char -1) (looking-at (concat "'\\s-*" matlab-elipsis-string)))))) (goto-char pos) (goto-char pos2) (forward-char 1) (insert "[") (goto-char pos) (forward-char 1)) ;(delete-horizontal-space) (skip-chars-forward " \t") (insert "' " matlab-elipsis-string "\n") (matlab-indent-line) (insert "'") ;; Re scan forward for the end of the string. Add an end bracket ;; if there isn't one already. Also add an apostrophe if necessary. (if (not (looking-at "'\\s-*]")) (save-excursion (if (not (re-search-forward "[^']'[^']" (line-end-position) t)) (progn (end-of-line) (insert "']") (move-marker m (- (point) 2))) (forward-char -2) (if (not (looking-at "'\\s-*]")) (progn (forward-char 1) (insert "]")))))) )))) (goto-char m))) )))) (defun matlab-join-comment-lines () "Join current comment line to the next comment line." ;; New w/ V2.0: This used to join the previous line, but I could find ;; no editors that had a "join" that did that. I modified join to have ;; a behaviour I thought more inline with other editors. (interactive) (end-of-line) (if (looking-at "\n[ \t]*%") (replace-match " " t t nil) (error "No following comment to join with"))) (defun matlab-fill-region (beg-region end-region &optional justify-flag) "Fill the region between BEG-REGION and END-REGION. Non-nil JUSTIFY-FLAG means justify comment lines as well." (interactive "*r\nP") (let ((end-reg-mk (make-marker))) (set-marker end-reg-mk end-region) (goto-char beg-region) (beginning-of-line) (while (< (point) end-reg-mk) ;; This function must also leave the point at the end of the ;; justified line. (matlab-fill-paragraph justify-flag) (forward-line 1) (beginning-of-line)))) (defun matlab-fill-comment-line (&optional justify) "Fill the current comment line. With optional argument, JUSTIFY the comment as well." (interactive) (if (not (matlab-comment-on-line)) (error "No comment to fill")) (beginning-of-line) ;; First, find the beginning of this comment... (while (and (looking-at matlab-cline-start-skip) (not (bobp))) (forward-line -1) (beginning-of-line)) (if (not (looking-at matlab-cline-start-skip)) (forward-line 1)) ;; Now scan to the end of this comment so we have our outer bounds, ;; and narrow to that region. (save-restriction (narrow-to-region (point) (save-excursion (while (and (looking-at matlab-cline-start-skip) (not (save-excursion (end-of-line) (eobp)))) (forward-line 1) (beginning-of-line)) (if (not (looking-at matlab-cline-start-skip)) (forward-line -1)) (end-of-line) (point))) ;; Find the fill prefix... (matlab-comment-on-line) (looking-at "%[ \t]*") (let ((fill-prefix (concat (make-string (current-column) ? ) (match-string 0)))) (fill-region (point-min) (point-max) justify)))) (defun matlab-justify-line () "Delete space on end of line and justify." (interactive) (save-excursion (end-of-line) (delete-horizontal-space) (justify-current-line))) (defun matlab-fill-paragraph (arg) "When in a comment, fill the current paragraph. Paragraphs are always assumed to be in a comment. ARG is passed to `fill-paragraph' and will justify the text." (interactive "P") (cond ((or (matlab-ltype-comm) (and (matlab-cursor-in-comment) (not (matlab-lattr-cont)))) ;; We are in a comment, lets fill the paragraph with some ;; nice regular expressions. ;; Cell start/end markers of %% also separate paragraphs (let ((paragraph-separate "%%\\|%[a-zA-Z]\\|%[ \t]*$\\|[ \t]*$") (paragraph-start "%[a-zA-Z]\\|%[ \t]*$\\|[ \t]*$") (paragraph-ignore-fill-prefix nil) (start (save-excursion (matlab-beginning-of-command) (if (looking-at "%%") (progn (end-of-line) (forward-char 1))) (point))) (end (save-excursion (matlab-end-of-command) (point))) (fill-prefix nil)) (matlab-set-comm-fill-prefix) (save-restriction ;; Ben North fixed to handle comment at the end of ;; a buffer. (narrow-to-region start (min (point-max) (+ end 1))) (fill-paragraph arg)))) ((matlab-ltype-code) ;; Ok, lets get the outer bounds of this command, then ;; completely refill it using the smart line breaking code. (save-restriction (narrow-to-region (save-excursion (matlab-beginning-of-command) (beginning-of-line) (point)) (save-excursion (matlab-end-of-command) (point))) ;; Remove all line breaks (goto-char (point-min)) (while (and (re-search-forward "$" nil t) (not (eobp))) (delete-horizontal-space) ;; Blow away continuation marks (if (matlab-lattr-cont) (progn (goto-char (match-beginning 0)) (forward-char 1) (delete-region (point) (matlab-point-at-eol)))) ;; Zap the CR (if (not (eobp)) (delete-char 1)) ;; Clean up whitespace (delete-horizontal-space) ;; Clean up trailing comments (if (and (looking-at "% *") (matlab-cursor-in-comment)) (progn (delete-char 1) (delete-horizontal-space))) (insert " ")) ;; Now fill till we are done (goto-char (point-max)) (while (or (> (current-column) (+ fill-column matlab-fill-fudge)) (> (current-column) matlab-fill-fudge-hard-maximum)) (if (= (point) (progn (matlab-auto-fill) (point))) (error "Fill algorith failed!")) (if arg (save-excursion (forward-line -1) (matlab-justify-line)))) (if arg (save-excursion (forward-line -1) (matlab-justify-line))))) (t (message "Paragraph Fill not supported in this context.")))) ;;; Semantic text insertion and management ==================================== (defun matlab-find-recent-variable-list (prefix) "Return a list of most recent variables starting with PREFIX as a string. Reverse searches for the following are done first: 1) Assignment 2) if|for|while|switch 3) global variables 4) function arguments. All elements are saved in a list, which is then uniqafied. If NEXT is non-nil, then the next element from the saved list is used. If the list is empty, then searches continue backwards through the code." (matlab-navigation-syntax (let* ((bounds (save-excursion (if (re-search-backward "^\\s-*function\\>" nil t) (match-beginning 0) (point-min)))) (syms (append (save-excursion (let ((lst nil)) (while (and (re-search-backward (concat "^\\s-*\\(" prefix "\\w+\\)\\s-*=") bounds t) (< (length lst) 10)) (setq lst (cons (match-string 1) lst))) (nreverse lst))) (save-excursion (let ((lst nil)) (while (and (re-search-backward (concat "\\<\\(" matlab-block-beg-pre-no-if "\\)\\s-+(?\\s-*\\(" prefix "\\w+\\)\\>") bounds t) (< (length lst) 10)) (setq lst (cons (match-string 2) lst))) (nreverse lst))) (save-excursion (if (re-search-backward "^\\s-*global\\s-+" bounds t) (let ((lst nil) m e) (goto-char (match-end 0)) (while (looking-at "\\(\\w+\\)\\([ \t]+\\|$\\)") (setq m (match-string 1) e (match-end 0)) (if (equal 0 (string-match prefix m)) (setq lst (cons m lst))) (goto-char e)) (nreverse lst)))) (save-excursion (if (and (re-search-backward "^\\s-*function\\>" bounds t) (re-search-forward "\\<\\(\\w+\\)(" (matlab-point-at-eol) t)) (let ((lst nil) m e) (while (looking-at "\\(\\w+\\)\\s-*[,)]\\s-*") (setq m (match-string 1) e (match-end 0)) (if (equal 0 (string-match prefix m)) (setq lst (cons m lst))) (goto-char e)) (nreverse lst)))))) (fl nil)) (while syms (if (car syms) (setq fl (cons (car syms) fl))) (setq syms (cdr syms))) (matlab-uniquafy-list (nreverse fl))))) (defvar matlab-most-recent-variable-list nil "Maintained by `matlab-find-recent-variable'.") (defun matlab-find-recent-variable (prefix &optional next) "Return the most recently used variable starting with PREFIX as a string. See `matlab-find-recent-variable-list' for details. In NEXT is non-nil, than continue through the list of elements." (if next (let ((next (car matlab-most-recent-variable-list))) (setq matlab-most-recent-variable-list (cdr matlab-most-recent-variable-list)) next) (let ((syms (matlab-find-recent-variable-list prefix)) (first nil)) (if (eq matlab-completion-technique 'complete) syms (setq first (car syms)) (setq matlab-most-recent-variable-list (cdr syms)) first)))) (defun matlab-find-user-functions-list (prefix) "Return a list of user defined functions that match PREFIX." (matlab-navigation-syntax (let ((syms (append (save-excursion (goto-char (point-min)) (let ((lst nil)) (while (re-search-forward "^\\s-*function\\>" nil t) (if (re-search-forward (concat "\\(" prefix "\\w+\\)\\s-*\\($\\|(\\)") (matlab-point-at-eol) t) (setq lst (cons (match-string 1) lst)))) (nreverse lst))) (let ((lst nil) (files (directory-files default-directory nil (concat "^" prefix "[a-zA-Z][a-zA-Z0-9_]+\\.m$")))) (while files (setq lst (cons (progn (string-match "\\.m" (car files)) (substring (car files) 0 (match-beginning 0))) lst) files (cdr files))) lst))) (fl nil)) (while syms (if (car syms) (setq fl (cons (car syms) fl))) (setq syms (cdr syms))) (matlab-uniquafy-list (nreverse fl))))) (defvar matlab-user-function-list nil "Maintained by `matlab-find-user-functions'.") (defun matlab-find-user-functions (prefix &optional next) "Return a user function that match PREFIX and return it. If optional argument NEXT is non-nil, then return the next found object." (if next (let ((next (car matlab-user-function-list))) (setq matlab-user-function-list (cdr matlab-user-function-list)) next) (let ((syms (matlab-find-user-functions-list prefix)) (first nil)) (if (eq matlab-completion-technique 'complete) syms (setq first (car syms)) (setq matlab-user-function-list (cdr syms)) first)))) (defvar matlab-generic-list-placeholder nil "Maintained by `matalb-generic-list-expand'. Holds sub-lists of symbols left to be expanded.") (defun matlab-generic-list-expand (list prefix &optional next) "Return an element from LIST that start with PREFIX. If optional NEXT argument is non nil, then the next element in the list is used. nil is returned if there are not matches." (if next (let ((next (car matlab-generic-list-placeholder))) (setq matlab-generic-list-placeholder (cdr matlab-generic-list-placeholder)) next) (let ((re (concat "^" (regexp-quote prefix))) (first nil) (fl nil)) (while list (if (string-match re (car list)) (setq fl (cons (car list) fl))) (setq list (cdr list))) (setq fl (nreverse fl)) (if (eq matlab-completion-technique 'complete) fl (setq first (car fl)) (setq matlab-generic-list-placeholder (cdr fl)) first)))) (defun matlab-solo-completions (prefix &optional next) "Return PREFIX matching elements for solo symbols. If NEXT then the next patch from the list is used." (matlab-generic-list-expand matlab-keywords-solo prefix next)) (defun matlab-value-completions (prefix &optional next) "Return PREFIX matching elements for value symbols. If NEXT then the next patch from the list is used." (matlab-generic-list-expand matlab-keywords-return prefix next)) (defun matlab-boolean-completions (prefix &optional next) "Return PREFIX matching elements for boolean symbols. If NEXT then the next patch from the list is used." (matlab-generic-list-expand matlab-keywords-boolean prefix next)) (defun matlab-property-completions (prefix &optional next) "Return PREFIX matching elements for property names in strings. If NEXT then the next property from the list is used." (let ((f (matlab-function-called-at-point)) (lst matlab-property-lists) (foundlst nil) (expandto nil)) ;; Look for this function. If it is a known function then we ;; can now use a subset of available properties! (while (and lst (not foundlst)) (if (string= (car (car lst)) f) (setq foundlst (cdr (car lst)))) (setq lst (cdr lst))) (if foundlst (setq foundlst (append foundlst matlab-core-properties)) (setq foundlst matlab-all-known-properties)) (setq expandto (matlab-generic-list-expand foundlst prefix next)) ;; This looks to see if we have a singular completion. If so, ;; then return it, and also append the "'" to the end. (cond ((and (listp expandto) (= (length expandto) 1)) (setq expandto (list (concat (car expandto) "'")))) ((stringp expandto) (setq expandto (concat expandto "'")))) expandto)) (defvar matlab-last-prefix nil "Maintained by `matlab-complete-symbol'. The prefix used for the first completion command.") (defvar matlab-last-semantic nil "Maintained by `matlab-complete-symbol'. The last type of semantic used while completing things.") (defvar matlab-completion-search-state nil "List of searching things we will be doing.") (defun matlab-complete-symbol (&optional arg) "Complete a partially typed symbol in a MATLAB mode buffer. If the previously entered command was also `matlab-complete-symbol' then undo the last completion, and find a new one. The types of symbols tried are based on the semantics of the current cursor position. There are two types of symbols. For example, if the cursor is in an if statement, boolean style functions and symbols are tried first. If the line is blank, then flow control, or high level functions are tried first. The completion technique is controlled with `matlab-completion-technique' It defaults to incremental completion described above. If a completion list is preferred, then change this to 'complete. If you just want a completion list once, then use the universal argument ARG to change it temporarily." (interactive "P") (matlab-navigation-syntax (let* ((prefix (if (and (not (eq last-command 'matlab-complete-symbol)) (member (preceding-char) '(? ?\t ?\n ?, ?\( ?\[ ?\'))) "" (buffer-substring-no-properties (save-excursion (forward-word -1) (point)) (point)))) (sem (matlab-lattr-semantics prefix)) (matlab-completion-technique (if arg (cond ((eq matlab-completion-technique 'complete) 'increment) (t 'complete)) matlab-completion-technique))) (if (not (eq last-command 'matlab-complete-symbol)) (setq matlab-last-prefix prefix matlab-last-semantic sem matlab-completion-search-state (cond ((eq sem 'solo) '(matlab-solo-completions matlab-find-user-functions matlab-find-recent-variable)) ((eq sem 'boolean) '(matlab-find-recent-variable matlab-boolean-completions matlab-find-user-functions matlab-value-completions)) ((eq sem 'value) '(matlab-find-recent-variable matlab-find-user-functions matlab-value-completions matlab-boolean-completions)) ((eq sem 'property) '(matlab-property-completions matlab-find-user-functions matlab-find-recent-variable matlab-value-completions)) (t '(matlab-find-recent-variable matlab-find-user-functions matlab-value-completions matlab-boolean-completions))))) (cond ((eq matlab-completion-technique 'increment) (let ((r nil) (donext (eq last-command 'matlab-complete-symbol))) (while (and (not r) matlab-completion-search-state) (message "Expand with %S" (car matlab-completion-search-state)) (setq r (funcall (car matlab-completion-search-state) matlab-last-prefix donext)) (if (not r) (setq matlab-completion-search-state (cdr matlab-completion-search-state) donext nil))) (delete-region (point) (progn (forward-char (- (length prefix))) (point))) (if r (insert r) (insert matlab-last-prefix) (message "No completions.")))) ((eq matlab-completion-technique 'complete) (let ((allsyms (apply 'append (mapcar (lambda (f) (funcall f prefix)) matlab-completion-search-state)))) (cond ((null allsyms) (message "No completions.") (ding)) ((= (length allsyms) 1) (delete-region (point) (progn (forward-char (- (length prefix))) (point))) (insert (car allsyms))) ((= (length allsyms) 0) (message "No completions.")) (t (let* ((al (mapcar (lambda (a) (list a)) allsyms)) (c (try-completion prefix al))) ;; This completion stuff lets us expand as much as is ;; available to us. When the completion is the prefix ;; then we want to display all the strings we've ;; encountered. (if (and (stringp c) (not (string= prefix c))) (progn (delete-region (point) (progn (forward-char (- (length prefix))) (point))) (insert c)) ;; `display-completion-list' does all the complex ;; ui work for us. (with-output-to-temp-buffer "*Completions*" (display-completion-list (matlab-uniquafy-list allsyms))))))))))))) (defun matlab-insert-end-block (&optional reindent) "Insert and END block based on the current syntax. Optional argument REINDENT indicates if the specified block should be re-indented." (interactive "P") (if (not (matlab-ltype-empty)) (progn (end-of-line) (insert "\n"))) (let ((valid t) (begin nil)) (save-excursion (condition-case nil (progn (matlab-backward-sexp t) (setq begin (point) valid (buffer-substring-no-properties (point) (save-excursion (re-search-forward "[\n,;.]" nil t) (point))))) (error (setq valid nil)))) (if (not valid) (error "No block to end") (insert "end") (if (stringp valid) (insert " % " valid)) (matlab-indent-line) (if reindent (indent-region begin (point) nil))))) (tempo-define-template "matlab-for" '("for " p "=" p "," > n> r> & "end" > %) "for" "Insert a MATLAB for statement" 'matlab-tempo-tags ) (tempo-define-template "matlab-while" '("while (" p ")," > n> r> & "end" > %) "while" "Insert a MATLAB while statement" 'matlab-tempo-tags ) (tempo-define-template "matlab-if" '("if " p > n r> "end" > n) "if" "Insert a MATLAB if statement" 'matlab-tempo-tags ) (tempo-define-template "matlab-if-else" '("if " p > n r> "else" > n "end" > n) "if" "Insert a MATLAB if statement" 'matlab-tempo-tags ) (tempo-define-template "matlab-try" '("try " > n r> "catch" > n p > n "end" > n) "try" "Insert a MATLAB try catch statement" 'matlab-tempo-tags ) (tempo-define-template "matlab-switch" '("switch " p > n "otherwise" > n r> "end" > n) "switch" "Insert a MATLAB switch statement with region in the otherwise clause." 'matlab-tempo-tags) (defun matlab-insert-next-case () "Insert a case statement inside this switch statement." (interactive) ;; First, make sure we are where we think we are. (let ((valid t)) (save-excursion (condition-case nil (progn (matlab-backward-sexp t) (setq valid (looking-at "switch"))) (error (setq valid nil)))) (if (not valid) (error "Not in a switch statement"))) (if (not (matlab-ltype-empty)) (progn (end-of-line) (insert "\n"))) (indent-to 0) (insert "case ") (matlab-indent-line)) (tempo-define-template "matlab-function" '("function " (P "output argument(s): " output t) ;; Insert brackets only if there is more than one output argument (if (string-match "," (tempo-lookup-named 'output)) '(l "[" (s output) "]") '(l (s output))) ;; Insert equal sign only if there is output argument(s) (if (= 0 (length (tempo-lookup-named 'output))) nil " = ") ;; The name of a function, as defined in the first line, should ;; be the same as the name of the file without .m extension (if (= 1 (count-lines 1 (point))) (tempo-save-named 'fname (file-name-nondirectory (file-name-sans-extension (buffer-file-name)))) '(l (P "function name: " fname t))) (tempo-lookup-named 'fname) "(" (P "input argument(s): ") ")" n "% " (upcase (tempo-lookup-named 'fname)) " - " (P "H1 line: ") n "% " p n (if matlab-functions-have-end '(l "end" n))) "function" "Insert a MATLAB function statement" 'matlab-tempo-tags ) (defun matlab-stringify-region (begin end) "Put MATLAB 's around region, and quote all quotes in the string. Stringification allows you to type in normal MATLAB code, mark it, and then turn it into a MATLAB string that will output exactly what's in the region. BEGIN and END mark the region to be stringified." (interactive "r") (save-excursion (goto-char begin) (if (re-search-forward "\n" end t) (error "You may only stringify regions that encompass less than one line")) (let ((m (make-marker))) (move-marker m end) (goto-char begin) (insert "'") (while (re-search-forward "'" m t) (insert "'")) (goto-char m) (insert "'")))) (defun matlab-ispell-strings-region (begin end) "Spell check valid strings in region with Ispell. Argument BEGIN and END mark the region boundary." (interactive "r") (require 'ispell) (save-excursion (goto-char begin) ;; Here we use the font lock function for finding strings. ;; Its cheap, fast, and accurate. (while (and (matlab-font-lock-string-match-normal end) (ispell-region (match-beginning 2) (match-end 2)))))) (defun matlab-ispell-strings () "Spell check valid strings in the current buffer with Ispell. Calls `matlab-ispell-strings-region'" (interactive) (matlab-ispell-strings-region (point-min) (point-max))) (defun matlab-ispell-comments (&optional arg) "Spell check comments in the current buffer with Ispell. Optional ARG means to only check the current comment." (interactive "P") (let ((beg (point-min)) (end (point-max))) (if (and arg (matlab-ltype-comm)) (setq beg (save-excursion (matlab-beginning-of-command) (point)) end (save-excursion (matlab-end-of-command) (point)))) (save-excursion (goto-char beg) (beginning-of-line) (while (and (matlab-font-lock-comment-match end) (ispell-region (match-beginning 1) (match-end 1))))))) (defun matlab-generate-latex () "Convert a MATLAB M file into a Latex document for printing. Author: Uwe Brauer oub@eucmos.sim.ucm.es Created: 14 Feb 2002" (interactive "*") (save-restriction (save-excursion (goto-char (point-min)) (insert "\\documentclass[12pt]{report}\n \\usepackage{listings} \\lstloadlanguages{Matlab} \\lstset{language=Matlab,keywordstyle=\\bfseries,labelstep=1,escapechar=\\#} \\begin{document} \\begin{lstlisting}{}") (newline) (goto-char (point-max)) (insert "\n\\end{lstlisting}\n\\end{document}") (widen))) (font-lock-mode nil) (LaTeX-mode) (font-lock-mode nil)) ;;; Block highlighting ======================================================== (defvar matlab-block-highlighter-timer nil "The timer representing the block highlighter.") (defun matlab-enable-block-highlighting (&optional arg) "Start or stop the block highlighter. Optional ARG is 1 to force enable, and -1 to disable. If ARG is nil, then highlighting is toggled." (interactive "P") (if (not (fboundp 'matlab-run-with-idle-timer)) (setq matlab-highlight-block-match-flag nil)) ;; Only do it if it's enabled. (if (not matlab-highlight-block-match-flag) nil ;; Use post command idle hook as a local hook to dissuade too much ;; cpu time while doing other things. ;;(make-local-hook 'post-command-hook) (if (not arg) (setq arg (if (member 'matlab-start-block-highlight-timer post-command-hook) -1 1))) (if (> arg 0) (add-hook 'post-command-hook 'matlab-start-block-highlight-timer) (remove-hook 'post-command-hook 'matlab-start-block-highlight-timer)))) (defvar matlab-block-highlight-overlay nil "The last highlighted overlay.") (make-variable-buffer-local 'matlab-block-highlight-overlay) (defvar matlab-block-highlight-timer nil "Last started timer.") (make-variable-buffer-local 'matlab-block-highlight-timer) (defun matlab-start-block-highlight-timer () "Set up a one-shot timer if we are in MATLAB mode." (if (eq major-mode 'matlab-mode) (progn (if matlab-block-highlight-overlay (unwind-protect (matlab-delete-overlay matlab-block-highlight-overlay) (setq matlab-block-highlight-overlay nil))) (if matlab-block-highlight-timer (unwind-protect (matlab-cancel-timer matlab-block-highlight-timer) (setq matlab-block-highlight-timer nil))) (setq matlab-block-highlight-timer (matlab-run-with-idle-timer 1 nil 'matlab-highlight-block-match (current-buffer)))))) (defun matlab-highlight-block-match (&optional buff-when-launched) "Highlight a matching block if available. BUFF-WHEN-LAUNCHED is the buffer that was active when the timer was set." (setq matlab-block-highlight-timer nil) (if (null buff-when-launched) ;; We were passed a null. This indicates an old version of XEmacs ;; so just turn the feature off (setq matlab-highlight-block-match-flag nil) ;; Only do neat stuff in the same buffer as the one we were ;; initialized from. (when (and buff-when-launched (eq buff-when-launched (current-buffer))) (let ((inhibit-quit nil) ;turn on G-g (matlab-scan-on-screen-only t)) (if matlab-show-periodic-code-details-flag (matlab-show-line-info)) (if (not (matlab-cursor-in-string-or-comment)) (save-excursion (if (or (bolp) (looking-at "\\s-") (save-excursion (forward-char -1) (looking-at "\\s-"))) nil (forward-word -1)) (if (and (looking-at (concat (matlab-block-beg-re) "\\>")) (not (looking-at "function"))) (progn ;; We scan forward... (matlab-forward-sexp) (backward-word 1) (if (not (looking-at matlab-block-end-pre-if)) nil ;(message "Unterminated block, or end off screen.") (setq matlab-block-highlight-overlay (matlab-make-overlay (point) (progn (forward-word 1) (point)) (current-buffer))) (matlab-overlay-put matlab-block-highlight-overlay 'face 'matlab-region-face))) (if (and (looking-at (concat (matlab-block-end-pre) "\\>")) (not (looking-at "function")) (matlab-valid-end-construct-p)) (progn ;; We scan backward (forward-word 1) (condition-case nil (progn (matlab-backward-sexp) (if (not (looking-at (matlab-block-beg-re))) nil ;(message "Unstarted block at cursor.") (setq matlab-block-highlight-overlay (matlab-make-overlay (point) (progn (forward-word 1) (point)) (current-buffer))) (matlab-overlay-put matlab-block-highlight-overlay 'face 'matlab-region-face))) (error (message "Unstarted block at cursor.")))) ;; do nothing )))))))) ;;; M Block Folding with hideshow ============================================= (defun matlab-hideshow-forward-sexp-func (arg) "Move forward one sexp for hideshow. Argument ARG specifies the number of blocks to move forward." (beginning-of-line) (matlab-forward-sexp arg) ) (defun matlab-hideshow-adjust-beg-func (arg) "Adjust the beginning of a hideshow block. Argument ARG to make it happy." (end-of-line) (point) ) ;; Use this to enable hideshow in MATLAB. ;; It has not been tested by me enough. ;; REMOVE PUSHNEW FROM THIS LINE ;;(pushnew (list 'matlab-mode ;; (matlab-block-beg-pre) ;; (matlab-block-end-pre) ;; "%" ;; 'matlab-hideshow-forward-sexp-func ;; 'matlab-hideshow-adjust-beg-func ;; ) ;; hs-special-modes-alist :test 'equal) ;;; M Code verification & Auto-fix ============================================ (defun matlab-mode-verify-fix-file-fn () "Verify the current buffer from `write-contents-hooks'." (if matlab-verify-on-save-flag (matlab-mode-verify-fix-file (> (point-max) matlab-block-verify-max-buffer-size))) ;; Always return nil. nil) (defun matlab-mode-verify-fix-file (&optional fast) "Verify the current buffer satisfies all M things that might be useful. We will merely loop across a list of verifiers/fixers in `matlab-mode-verify-fix-functions'. If optional FAST is non-nil, do not perform usually lengthy checks." (interactive) (let ((p (point)) (l matlab-mode-verify-fix-functions)) (while l (funcall (car l) fast) (setq l (cdr l))) (goto-char p)) (if (interactive-p) (message "Done."))) (defun matlab-toggle-show-mlint-warnings () "Toggle `matlab-show-mlint-warnings'." (interactive) (setq matlab-show-mlint-warnings (not matlab-show-mlint-warnings)) (if matlab-highlight-cross-function-variables (if matlab-show-mlint-warnings (mlint-buffer) ; became true, recompute mlint info (mlint-clear-warnings))) ; became false, just remove hilighting ;; change mlint mode altogether (mlint-minor-mode (if (or matlab-highlight-cross-function-variables matlab-show-mlint-warnings) 1 -1))) (defun matlab-toggle-highlight-cross-function-variables () "Toggle `matlab-highlight-cross-function-variables'." (interactive) (setq matlab-highlight-cross-function-variables (not matlab-highlight-cross-function-variables)) (if matlab-show-mlint-warnings (if matlab-highlight-cross-function-variables (mlint-buffer) ; became true, recompute mlint info ; became false, just remove hilighting ... (mlint-clear-cross-function-variable-highlighting))) (mlint-minor-mode (if (or matlab-highlight-cross-function-variables matlab-show-mlint-warnings) 1 -1))) ; change mlint mode altogether ;; ;; Add more auto verify/fix functions here! ;; (defun matlab-mode-vf-functionname (&optional fast) "Verify/Fix the function name of this file. Optional argument FAST is ignored." (matlab-navigation-syntax (goto-char (point-min)) (while (and (or (matlab-ltype-empty) (matlab-ltype-comm)) (/= (matlab-point-at-eol) (point-max))) (forward-line 1)) (let ((func nil) (bn (file-name-sans-extension (file-name-nondirectory (buffer-file-name))))) (if (looking-at (matlab-match-function-re)) ;; The expression above creates too many numeric matches ;; to apply a known one to our function. We cheat by knowing that ;; match-end 0 is at the end of the function name. We can then go ;; backwards, and get the extents we need. Navigation syntax ;; lets us know that backward-word really covers the word. (let ((end (match-end 0)) (begin (progn (goto-char (match-end 0)) (forward-word -1) (point)))) (setq func (buffer-substring begin end)) (if (not (string= func bn)) (if (not (matlab-mode-highlight-ask begin end "Function and file names are different. Fix?")) nil (goto-char begin) (delete-region begin end) (insert bn)))))))) (defun matlab-mode-vf-block-matches-forward (&optional fast) "Verify/Fix unterminated (or un-ended) blocks. This only checks block regions like if/end. Optional argument FAST causes this check to be skipped." (goto-char (point-min)) (let ((go t) (expr (concat "\\<\\(" (matlab-block-beg-pre) "\\)\\>"))) (matlab-navigation-syntax (while (and (not fast) go (re-search-forward expr nil t)) (forward-word -1) ;back over the special word (let ((s (point))) (condition-case nil (if (and (not (matlab-cursor-in-string-or-comment)) (not (looking-at "function"))) (progn (matlab-forward-sexp) (forward-word -1) (if (not (looking-at (concat matlab-block-end-pre-no-if "\\>"))) (setq go nil))) (forward-word 1)) (error (setq go nil))) (if (and (not go) (goto-char s) (not (matlab-mode-highlight-ask (point) (save-excursion (forward-word 1) (point)) "Unterminated block. Continue anyway?"))) (error "Unterminated Block found!"))) (message "Block-check: %d%%" (/ (/ (* 100 (point)) (point-max)) 2)))))) (defun matlab-mode-vf-block-matches-backward (&optional fast) "Verify/fix unstarted (or dangling end) blocks. Optional argument FAST causes this check to be skipped." (goto-char (point-max)) (let ((go t) (expr (concat "\\<\\(" (matlab-block-end-no-function-re) "\\)\\>"))) (matlab-navigation-syntax (while (and (not fast) go (re-search-backward expr nil t)) (forward-word 1) (let ((s (point))) (condition-case nil (if (and (not (matlab-cursor-in-string-or-comment)) (matlab-valid-end-construct-p)) (matlab-backward-sexp) (backward-word 1)) (error (setq go nil))) (if (and (not go) (goto-char s) (not (matlab-mode-highlight-ask (point) (save-excursion (backward-word 1) (point)) "Unstarted block. Continue anyway?"))) (error "Unstarted Block found!"))) (message "Block-check: %d%%" (+ (/ (/ (* 100 (- (point-max) (point))) (point-max)) 2) 50)))))) ;;; Utility for verify/fix actions if you need to highlight ;; a section of the buffer for the user's approval. (defun matlab-mode-highlight-ask (begin end prompt) "Highlight from BEGIN to END while asking PROMPT as a yes-no question." (let ((mo (matlab-make-overlay begin end (current-buffer))) (ans nil)) (condition-case nil (progn (matlab-overlay-put mo 'face 'matlab-region-face) (setq ans (y-or-n-p prompt)) (matlab-delete-overlay mo)) (quit (matlab-delete-overlay mo) (error "Quit"))) ans)) ;;; Quiesce an M file to remove accidental display of ANS during a run. ;; Useful if you have random outputs and you don't know where they are from, ;; or before compiling to standalone where some functions now have outputs ;; that did not have outputs earlier. ;; ;; You probably don't want this as a default verify function (defvar matlab-quiesce-nosemi-regexp "\\s-*\\(function\\|parfor\\|for\\|spmd\\|while\\|try\\|catch\\|\ switch\\|otherwise\\|case\\|break\\|if\\|else\\|end\\|return\\|disp\\|\ $\\|%\\)" "Regular expression used to detect if a semicolon is needed at the end of a line.") (defun matlab-mode-vf-quiesce-buffer (&optional fast) "Find all commands that do not end in ;, and add one. This has the effect of removing any extraneous output that may not be desired. Optional argument FAST is not used." (interactive) (save-excursion (push-mark) (goto-char (point-min)) (let ((msgpos 0) (dir .2)) (while (not (save-excursion (end-of-line) (eobp))) (message (aref [ "Scanning o...." "Scanning .o..." "Scanning ..o.." "Scanning ...o." "Scanning ....o" ] (floor msgpos))) (setq msgpos (+ msgpos dir)) (if (or (> msgpos 5) (< msgpos 0)) (setq dir (- dir) msgpos (+ (* 2 dir) msgpos))) (matlab-end-of-command (point)) (if (matlab-cursor-in-comment) (progn (matlab-comment-on-line) (skip-chars-backward " \t"))) (if (and (not (= (preceding-char) ?\;)) (not (matlab-cursor-in-string t)) (not (save-excursion (beginning-of-line) (looking-at matlab-quiesce-nosemi-regexp)))) (let ((p (point))) (skip-chars-backward " \t") (if (/= p (point)) (progn (delete-region p (point)) (forward-line -1)) (if (matlab-mode-highlight-ask (point) (+ 1 (point)) "Add Semi colon here? ") (insert ";"))))) (forward-line 1)))) (message "Scanning .... done")) ;;; V19 stuff ================================================================= (defvar matlab-mode-menu-keymap nil "Keymap used in MATLAB mode to provide a menu.") (defun matlab-frame-init () "Initialize Emacs menu system." (interactive) ;; make a menu keymap (easy-menu-define matlab-mode-menu matlab-mode-map "MATLAB menu" '("MATLAB" ["Start MATLAB" matlab-shell :active (not (or (matlab-with-emacs-link) (matlab-shell-active-p))) :visible (not (matlab-shell-active-p)) ] ["Switch to MATLAB" matlab-shell :active (and (not (matlab-with-emacs-link)) (matlab-shell-active-p)) :visible (matlab-shell-active-p) ] ["Save and go" matlab-shell-save-and-go t] ["Run Region" matlab-shell-run-region t] ["Run Cell" matlab-shell-run-cell t] ["Version" matlab-show-version t] "----" ["Find M file" matlab-find-file-on-path t] ["Show M-Lint Warnings" matlab-toggle-show-mlint-warnings :active (and (locate-library "mlint") (fboundp 'mlint-minor-mode)) :style toggle :selected matlab-show-mlint-warnings ] ("Auto Fix" ["Verify/Fix source" matlab-mode-verify-fix-file t] ["Spell check strings" matlab-ispell-strings t] ["Spell check comments" matlab-ispell-comments t] ["Quiesce source" matlab-mode-vf-quiesce-buffer t] ) ("Navigate" ["Beginning of Command" matlab-beginning-of-command t] ["End of Command" matlab-end-of-command t] ["Forward Block" matlab-forward-sexp t] ["Backward Block" matlab-backward-sexp t] ["Beginning of Function" matlab-beginning-of-defun t] ["End of Function" matlab-end-of-defun t]) ("Format" ["Justify Line" matlab-justify-line t] ["Fill Region" matlab-fill-region t] ["Fill Comment Paragraph" matlab-fill-paragraph (save-excursion (matlab-comment-on-line))] ["Join Comment" matlab-join-comment-lines (save-excursion (matlab-comment-on-line))] ["Comment Region" matlab-comment-region t] ["Uncomment Region" matlab-uncomment-region t] ["Indent Synactic Block" matlab-indent-sexp]) ("Insert" ["Complete Symbol" matlab-complete-symbol t] ["Comment" matlab-comment t] ["if end" tempo-template-matlab-if t] ["if else end" tempo-template-matlab-if-else t] ["for end" tempo-template-matlab-for t] ["switch otherwise end" tempo-template-matlab-switch t] ["Next case" matlab-insert-next-case t] ["try catch end" tempo-template-matlab-try t] ["while end" tempo-template-matlab-while t] ["End of block" matlab-insert-end-block t] ["Function" tempo-template-matlab-function t] ["Stringify Region" matlab-stringify-region t] ) ("Customize" ; ["Auto Fill Counts Elipsis" ; (lambda () (setq matlab-fill-count-ellipsis-flag ; (not matlab-fill-count-ellipsis-flag))) ; :style toggle :selected 'matlab-fill-count-ellipsis-flag] ["Indent Function Body" (setq matlab-indent-function-body (not (matlab-indent-function-body-p))) :style toggle :selected matlab-indent-function-body] ["Functions Have end" matlab-toggle-functions-have-end :style toggle :selected matlab-functions-have-end] ["Verify File on Save" (setq matlab-verify-on-save-flag (not matlab-verify-on-save-flag)) :style toggle :selected matlab-verify-on-save-flag] ["Auto Fill does Code" (setq matlab-fill-code (not matlab-fill-code)) :style toggle :selected matlab-fill-code ] ["Periodic Code Details" (setq matlab-show-periodic-code-details-flag (not matlab-show-periodic-code-details-flag)) :style toggle :selected matlab-show-periodic-code-details-flag ] ["Highlight Matching Blocks" (matlab-enable-block-highlighting) :style toggle :selected (member 'matlab-start-block-highlight-timer post-command-hook) ] ["Highlight Cross-Function Variables" matlab-toggle-highlight-cross-function-variables :active (locate-library "mlint") :style toggle :selected matlab-highlight-cross-function-variables ] ["Add Needed Semicolon on RET" (setq matlab-return-add-semicolon (not matlab-return-add-semicolon)) :style toggle :selected matlab-return-add-semicolon ] ["Customize" (customize-group 'matlab) (and (featurep 'custom) (fboundp 'custom-declare-variable)) ] ) "----" ["Run M Command" matlab-shell-run-command (matlab-shell-active-p)] ["Describe Command" matlab-shell-describe-command (matlab-shell-active-p)] ["Describe Variable" matlab-shell-describe-variable (matlab-shell-active-p)] ["Command Apropos" matlab-shell-apropos (matlab-shell-active-p)] ["Topic Browser" matlab-shell-topic-browser (matlab-shell-active-p)] )) (easy-menu-add matlab-mode-menu matlab-mode-map)) ;;; MATLAB shell ============================================================= (defgroup matlab-shell nil "MATLAB shell mode." :prefix "matlab-shell-" :group 'matlab) (defcustom matlab-shell-command "matlab" "*The name of the command to be run which will start the MATLAB process." :group 'matlab-shell :type 'string) (defcustom matlab-shell-command-switches '("-nodesktop") "*Command line parameters run with `matlab-shell-command'. Command switches are a list of strings. Each entry is one switch." :group 'matlab-shell :type '(list :tag "Switch: ")) (defcustom matlab-shell-echoes t "*If `matlab-shell-command' echoes input." :group 'matlab-shell :type 'boolean) (defvar matlab-shell-running-matlab-version nil "The version of MATLAB running in the current `matlab-shell' buffer.") (defvar matlab-shell-running-matlab-release nil "The release of MATLAB running in the curbrent `matlab-shell' buffer.") (defvar matlab-shell-use-emacs-toolbox ;; matlab may not be on path. (Name change, explicit load, etc) (let* ((mlfile (locate-library "matlab")) (dir (expand-file-name "toolbox/emacsinit.m" (file-name-directory (or mlfile ""))))) (and mlfile (file-exists-p dir))) "Add the `matlab-shell' MATLAB toolbox to the MATLAB path on startup.") (defvar matlab-shell-emacsclient-command "emacsclient -n" "The command to use as an external editor for MATLAB. Using emacsclient allows the currently running Emacs to also be the external editor for MATLAB.") (defcustom matlab-shell-history-file "~/.matlab/%s/history.m" "*Location of the history file. A %s is replaced with the MATLAB version release number, such as R12. This file is read to initialize the comint input ring.") (defcustom matlab-shell-input-ring-size 32 "*Number of history elements to keep." :group 'matlab-shell :type 'integer) (defcustom matlab-shell-enable-gud-flag t "*Non-nil means to use GUD mode when running the MATLAB shell." :group 'matlab-shell :type 'boolean) (defcustom matlab-shell-mode-hook nil "*List of functions to call on entry to MATLAB shell mode." :group 'matlab-shell :type 'hook) (defcustom matlab-shell-ask-MATLAB-for-completions t "When Non-nil, ask MATLAB for a completion list. When nil, just complete file names. (The original behavior.) At this time, MATLAB based completion can be slow if there are a lot of possible answers." :group 'matlab-shell :type 'boolean) (defvar matlab-shell-buffer-name "MATLAB" "Name used to create `matlab-shell' mode buffers. This name will have *'s surrounding it.") (defun matlab-shell-active-p () "Return t if the MATLAB shell is active." (if (get-buffer (concat "*" matlab-shell-buffer-name "*")) (save-excursion (set-buffer (concat "*" matlab-shell-buffer-name "*")) (if (comint-check-proc (current-buffer)) (current-buffer))))) (defvar matlab-shell-mode-map () "Keymap used in `matlab-shell-mode'.") (defvar matlab-shell-font-lock-keywords-1 (append matlab-font-lock-keywords matlab-shell-font-lock-keywords) "Keyword symbol used for font-lock mode.") (defvar matlab-shell-font-lock-keywords-2 (append matlab-shell-font-lock-keywords-1 matlab-gaudy-font-lock-keywords) "Keyword symbol used for gaudy font-lock symbols.") (defvar matlab-shell-font-lock-keywords-3 (append matlab-shell-font-lock-keywords-2 matlab-really-gaudy-font-lock-keywords) "Keyword symbol used for really gaudy font-lock symbols.") (defvar matlab-prompt-seen nil "Track visibility of MATLAB prompt in MATLAB Shell.") (eval-when-compile (require 'gud) (require 'comint) (require 'shell)) ;;;###autoload (defun matlab-shell () "Create a buffer with MATLAB running as a subprocess. MATLAB shell cannot work on the MS Windows platform because MATLAB is not a console application." (interactive) ;; MATLAB shell does not work by default on the Windows platform. Only ;; permit it's operation when the shell command string is different from ;; the default value. (True when the engine program is running.) (if (and (or (eq window-system 'pc) (eq window-system 'w32)) (string= matlab-shell-command "matlab")) (error "MATLAB cannot be run as a inferior process. \ Try C-h f matlab-shell RET")) (require 'shell) (require 'gud) ;; Make sure this is safe... (if (and matlab-shell-enable-gud-flag (fboundp 'gud-def)) ;; We can continue using GUD nil (message "Sorry, your emacs cannot use the MATLAB Shell GUD features.") (setq matlab-shell-enable-gud-flag nil)) (switch-to-buffer (concat "*" matlab-shell-buffer-name "*")) (if (matlab-shell-active-p) nil ;; Clean up crufty state (kill-all-local-variables) ;; Build keymap here in case someone never uses comint mode (if matlab-shell-mode-map () (setq matlab-shell-mode-map (let ((km (make-sparse-keymap 'matlab-shell-mode-map))) (if (fboundp 'set-keymap-parent) (set-keymap-parent km comint-mode-map) ;; 19.31 doesn't have set-keymap-parent (setq km (nconc km comint-mode-map))) (substitute-key-definition 'next-error 'matlab-shell-last-error km global-map) (define-key km [(control h) (control m)] matlab-help-map) (define-key km "\C-c." 'matlab-find-file-on-path) (define-key km [(tab)] 'matlab-shell-tab) (define-key km "\C-i" 'matlab-shell-tab) (define-key km [(control up)] 'comint-previous-matching-input-from-input) (define-key km [(control down)] 'comint-next-matching-input-from-input) (define-key km [up] 'matlab-shell-previous-matching-input-from-input) (define-key km [down] 'matlab-shell-next-matching-input-from-input) (define-key km [(control return)] 'comint-kill-input) (define-key km "\C-?" 'matlab-shell-delete-backwards-no-prompt) (define-key km [(backspace)] 'matlab-shell-delete-backwards-no-prompt) km))) (switch-to-buffer ;; Thx David Chappaz for reminding me about this patch. (let* ((windowid (frame-parameter (selected-frame) 'outer-window-id)) (newvar (concat "WINDOWID=" windowid)) (process-environment (cons newvar process-environment))) (apply 'make-comint matlab-shell-buffer-name matlab-shell-command nil matlab-shell-command-switches))) (setq shell-dirtrackp t) (comint-mode) (if matlab-shell-enable-gud-flag (progn (gud-mode) (make-local-variable 'matlab-prompt-seen) (setq matlab-prompt-seen nil) (make-local-variable 'gud-marker-filter) (setq gud-marker-filter 'gud-matlab-marker-filter) (make-local-variable 'gud-find-file) (setq gud-find-file 'gud-matlab-find-file) (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) (gud-set-buffer)) ;; What to do when there is no GUD ;(set-process-filter (get-buffer-process (current-buffer)) ; 'matlab-shell-process-filter) ) ;; Comint and GUD both try to set the mode. Now reset it to ;; matlab mode. (matlab-shell-mode))) (defcustom matlab-shell-logo (if (fboundp 'locate-data-file) ;; Starting from XEmacs 20.4 use locate-data-file (locate-data-file "matlab.xpm") (expand-file-name "matlab.xpm" data-directory)) "*The MATLAB logo file." :group 'matlab-shell :type '(choice (const :tag "None" nil) (file :tag "File" ""))) (defun matlab-shell-hack-logo (str) "Replace the text logo with a real logo. STR is passed from the commint filter." (when (string-match "< M A T L A B >" str) (save-excursion (when (re-search-backward "^[ \t]+< M A T L A B (R) >" (point-min) t) (delete-region (match-beginning 0) (match-end 0)) (insert (make-string 16 ? )) (set-extent-begin-glyph (make-extent (point) (point)) (make-glyph matlab-shell-logo)))) ;; Remove this function from `comint-output-filter-functions' (remove-hook 'comint-output-filter-functions 'matlab-shell-hack-logo)) ) (defun matlab-shell-version-scrape (str) "Scrape the MATLAB Version from the MATLAB startup text. Argument STR is the string to examine for version information." (when (string-match "\\(Version\\)\\s-+\\([.0-9]+\\)\\s-+(\\(R[.0-9]+[ab]?\\))" str) ;; Extract the release number (setq matlab-shell-running-matlab-version (match-string 2 str) matlab-shell-running-matlab-release (match-string 3 str)) ;; Now get our history loaded (setq comint-input-ring-file-name (format matlab-shell-history-file matlab-shell-running-matlab-release)) (if (fboundp 'comint-read-input-ring) (comint-read-input-ring t)) ;; Remove the scrape from our list of things to do. (remove-hook 'comint-output-filter-functions 'matlab-shell-version-scrape))) (defun matlab-shell-mode () "Run MATLAB as a subprocess in an Emacs buffer. This mode will allow standard Emacs shell commands/completion to occur with MATLAB running as an inferior process. Additionally, this shell mode is integrated with `matlab-mode', a major mode for editing M code. > From an M file buffer: \\ \\[matlab-shell-save-and-go] - Save the current M file, and run it in a \ MATLAB shell. > From Shell mode: \\ \\[matlab-shell-last-error] - find location of last MATLAB runtime error \ in the offending M file. > From an M file, or from Shell mode: \\ \\[matlab-shell-run-command] - Run COMMAND and show result in a popup buffer. \\[matlab-shell-describe-variable] - Show variable contents in a popup buffer. \\[matlab-shell-describe-command] - Show online documentation for a command \ in a popup buffer. \\[matlab-shell-apropos] - Show output from LOOKFOR command in a popup buffer. \\[matlab-shell-topic-browser] - Topic browser using HELP. > Keymap: \\{matlab-mode-map}" (setq major-mode 'matlab-shell-mode mode-name "M-Shell" comint-prompt-regexp "^\\(K\\|EDU\\)?>> *" comint-delimiter-argument-list (list [ 59 ]) ; semi colon comint-dynamic-complete-functions '(comint-replace-by-expanded-history) comint-process-echoes matlab-shell-echoes ) ;; matlab-shell variable setup (make-local-variable 'matlab-shell-last-error-anchor) (setq matlab-shell-last-error-anchor nil) ;; Shell Setup (require 'shell) (if (fboundp 'shell-directory-tracker) (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)) ;; patch Eli Merriam ;; Add a spiffy logo if we are running XEmacs (if (and (string-match "XEmacs" emacs-version) (stringp matlab-shell-logo) (file-readable-p matlab-shell-logo)) (add-hook 'comint-output-filter-functions 'matlab-shell-hack-logo)) ;; Add a version scraping logo identification filter. (add-hook 'comint-output-filter-functions 'matlab-shell-version-scrape) ;; Add pseudo html-renderer (add-hook 'comint-output-filter-functions 'matlab-shell-render-html-anchor nil t) (add-hook 'comint-output-filter-functions 'matlab-shell-render-html-txt-format nil t) (add-hook 'comint-output-filter-functions 'matlab-shell-render-errors-as-anchor nil t) ;; Scroll to bottom after running cell/region (add-hook 'comint-output-filter-functions 'comint-postoutput-scroll-to-bottom) (make-local-variable 'comment-start) (setq comment-start "%") (use-local-map matlab-shell-mode-map) (set-syntax-table matlab-mode-syntax-table) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '((matlab-shell-font-lock-keywords-1 matlab-shell-font-lock-keywords-2 matlab-shell-font-lock-keywords-3) t nil ((?_ . "w")))) (set (make-local-variable 'comint-input-ring-size) matlab-shell-input-ring-size) (set (make-local-variable 'comint-input-ring-file-name) (format matlab-shell-history-file "R12")) (if (fboundp 'comint-read-input-ring) (comint-read-input-ring t)) (make-local-variable 'gud-marker-acc) (easy-menu-define matlab-shell-menu matlab-shell-mode-map "MATLAB shell menu" '("MATLAB" ["Goto last error" matlab-shell-last-error t] "----" ["Stop On Errors" matlab-shell-dbstop-error t] ["Don't Stop On Errors" matlab-shell-dbclear-error t] "----" ["Run Command" matlab-shell-run-command t] ["Describe Variable" matlab-shell-describe-variable t] ["Describe Command" matlab-shell-describe-command t] ["Lookfor Command" matlab-shell-apropos t] ["Topic Browser" matlab-shell-topic-browser t] "----" ["Demos" matlab-shell-demos t] ["Close Current Figure" matlab-shell-close-current-figure t] ["Close Figures" matlab-shell-close-figures t] "----" ["Customize" (customize-group 'matlab-shell) (and (featurep 'custom) (fboundp 'custom-declare-variable)) ] ["Exit" matlab-shell-exit t])) (easy-menu-add matlab-shell-menu matlab-shell-mode-map) (if matlab-shell-enable-gud-flag (progn (gud-def gud-break "dbstop at %l in %f" "\C-b" "Set breakpoint at current line.") (gud-def gud-remove "dbclear at %l in %f" "\C-d" "Remove breakpoint at current line") (gud-def gud-step "dbstep in" "\C-s" "Step one source line, possibly into a function.") (gud-def gud-next "dbstep %p" "\C-n" "Step over one source line.") (gud-def gud-cont "dbcont" "\C-r" "Continue with display.") (gud-def gud-finish "dbquit" "\C-f" "Finish executing current function.") (gud-def gud-up "dbup %p" "<" "Up N stack frames (numeric arg).") (gud-def gud-down "dbdown %p" ">" "Down N stack frames (numeric arg).") (gud-def gud-print "%e" "\C-p" "Evaluate M expression at point.") (if (fboundp 'gud-make-debug-menu) (gud-make-debug-menu)) (if (fboundp 'gud-overload-functions) (gud-overload-functions '((gud-massage-args . gud-matlab-massage-args) (gud-marker-filter . gud-matlab-marker-filter) (gud-find-file . gud-matlab-find-file)))) ;; XEmacs doesn't seem to have this concept already. Oh well. (setq gud-marker-acc nil) ;; XEmacs has problems w/ this variable. Set it here. (set-marker comint-last-output-start (point-max)) )) (run-hooks 'matlab-shell-mode-hook) (matlab-show-version) ) (defvar gud-matlab-marker-regexp-prefix "error:\\|opentoline" "A prefix to scan for to know if output might be scarfed later.") (defvar matlab-shell-html-map (let ((km (make-sparse-keymap))) (if (string-match "XEmacs" emacs-version) (define-key km [button2] 'matlab-shell-html-click) (define-key km [mouse-2] 'matlab-shell-html-click)) (define-key km [return] 'matlab-shell-html-go) km) "Keymap used on overlays that represent errors.") ;; ANCHORS (defvar matlab-anchor-beg "" "Beginning of html anchor.") (defvar matlab-anchor-end "" "End of html anchor.") (defun matlab-shell-render-html-anchor (str) "Render html anchors inserted into the MATLAB shell buffer. Argument STR is the text for the anchor." (if (string-match matlab-anchor-end str) (save-excursion (while (re-search-backward matlab-anchor-beg ;; Arbitrary back-buffer. We don't ;; usually get text in such huge chunks (max (point-min) (- (point-max) 8192)) t) (let* ((anchor-beg-start (match-beginning 0)) (anchor-beg-finish (match-end 0)) (anchor-text (match-string 1)) (anchor-end-finish (search-forward matlab-anchor-end)) (anchor-end-start (match-beginning 0)) (o (matlab-make-overlay anchor-beg-finish anchor-end-start))) (matlab-overlay-put o 'mouse-face 'highlight) (matlab-overlay-put o 'face 'underline) (matlab-overlay-put o 'matlab-url anchor-text) (matlab-overlay-put o 'keymap matlab-shell-html-map) (matlab-overlay-put o 'help-echo anchor-text) (delete-region anchor-end-start anchor-end-finish) (delete-region anchor-beg-start anchor-beg-finish) )))) ) ;; TEXT FORMATTING (defvar matlab-txt-format-beg "<\\(strong\\|u\\)>" "Beginning of html text formatting signal in HTML.") (defvar matlab-txt-format-end "" "End of some html text formatter. Includes a %s to match the kind of text format start regexp.") (defun matlab-shell-render-html-txt-format (str) "Render html text format inserted into the MATLAB shell buffer. Argument STR is the text for the text formater." (if (string-match "" str) (save-excursion (while (re-search-backward matlab-txt-format-beg ;; Arbitrary back-buffer. We don't ;; usually get text in such huge chunks (max (point-min) (- (point-max) 8192)) t) (let* ((txt-format-beg-start (match-beginning 0)) (txt-format-beg-finish (match-end 0)) (txt-format-text (match-string 1)) (txt-format-end-finish ;; The finish combines the text from the start to get an ;; exact match. (search-forward (format matlab-txt-format-end txt-format-text))) (txt-format-end-start (match-beginning 0)) (o (matlab-make-overlay txt-format-beg-finish txt-format-end-start))) (cond ((string= txt-format-text "strong") (upcase-region txt-format-beg-finish txt-format-end-start) (matlab-overlay-put o 'face 'bold)) ((string= txt-format-text "u") (matlab-overlay-put o 'face 'underline)) (t ;; If we don't match, delete the overlay instead. (matlab-delete-overlay o) (setq o nil) )) (when o (delete-region txt-format-end-start txt-format-end-finish) (delete-region txt-format-beg-start txt-format-beg-finish)) )))) ) ;; The regular expression covers the following form: ;; Errors: Error in ==> ;; On line # ==> ;; Errors: Error using ==> at <#> ;; Syntax: Syntax error in ==> ;; On line # ==> ;; Warning: In at line # (defvar gud-matlab-error-regexp (concat "\\(Error \\(?:in\\|using\\) ==>\\|Syntax error in ==>\\|In\\) " "\\([-@.a-zA-Z_0-9/ \\\\:]+\\)\\(?:>[^ ]+\\)?.*[\n ]\\(?:On\\|at\\)\\(?: line\\)? " "\\([0-9]+\\) ?") "Regular expression finding where an error occurred.") (defvar matlab-shell-last-error-anchor nil "Last point where an error anchor was set.") (defvar matlab-shell-last-anchor-as-frame nil ;; NOTE: this isn't being used yet. "The last error anchor saved, represented as a debugger frame.") (defun matlab-shell-render-errors-as-anchor (str) "Detect non-url errors, and treat them as if they were url anchors. Argument STR is the text that might have errors in it." (save-excursion ;; We have found an error stack to investigate. (let ((first nil) (overlaystack nil)) (while (re-search-backward gud-matlab-error-regexp (if matlab-shell-last-error-anchor (min matlab-shell-last-error-anchor (point)) (point)) t) (let* ((err-start (match-beginning 0)) (err-end (match-end 0)) (err-text (match-string 0)) (err-file (match-string 2)) (err-line (match-string 3)) (o (matlab-make-overlay err-start err-end)) (url (concat "opentoline('" err-file "'," err-line ",0)")) ) (matlab-overlay-put o 'mouse-face 'highlight) (matlab-overlay-put o 'face 'underline) ;; The url will recycle opentoline code. (matlab-overlay-put o 'matlab-url url) (matlab-overlay-put o 'keymap matlab-shell-html-map) (matlab-overlay-put o 'help-echo (concat "Jump to error at " err-file ".")) (setq first url) (push o overlaystack) ;; Save as a frame (setq matlab-shell-last-anchor-as-frame (cons err-file err-line)) )) ;; Keep track of the very first error in this error stack. ;; It will represent the "place to go" for "go-to-last-error". (dolist (O overlaystack) (matlab-overlay-put O 'first-in-error-stack first)) ;; Once we've found something, don't scan it again. (setq matlab-shell-last-error-anchor (point-marker))))) (defvar gud-matlab-marker-regexp-1 "^K>>" "Regular expression for finding a file line-number.") (defvar gud-matlab-marker-regexp-2 (concat "^> In \\(" matlab-anchor-beg "\\|\\)\\([-.a-zA-Z0-9_>/@]+\\) \\((\\w+) \\|\\)at line \\([0-9]+\\)[ \n]+") "Regular expression for finding a file line-number. Please note: The leading > character represents the current stack frame, so if there are several frames, this makes sure we pick the right one to popup.") (defun gud-matlab-massage-args (file args) "Argument massager for starting matlab file. I don't think I have to do anything, but I'm not sure. FILE is ignored, and ARGS is returned." args) (defun gud-matlab-marker-filter (string) "Filters STRING for the Unified Debugger based on MATLAB output." (if matlab-prompt-seen nil (when (string-match ">> " string) (if matlab-shell-use-emacs-toolbox ;; Use our local toolbox directory. (process-send-string (get-buffer-process gud-comint-buffer) (format "addpath('%s','-begin'); rehash; emacsinit('%s');\n" (expand-file-name "toolbox" (file-name-directory (locate-library "matlab"))) matlab-shell-emacsclient-command)) ;; User doesn't want to use our fancy toolbox directory (process-send-string (get-buffer-process gud-comint-buffer) "if usejava('jvm'), \ com.mathworks.services.Prefs.setBooleanPref('EditorGraphicalDebugging', false); \ end\n" )) ;; Mark that we've seen at least one prompt. (setq matlab-prompt-seen t) )) (let ((garbage (concat "\\(" (regexp-quote "\C-g") "\\|" (regexp-quote "\033[H0") "\\|" (regexp-quote "\033[H\033[2J") "\\|" (regexp-quote "\033H\033[2J") "\\)"))) (while (string-match garbage string) (if (= (aref string (match-beginning 0)) ?\C-g) (beep t)) (setq string (replace-match "" t t string)))) (setq gud-marker-acc (concat gud-marker-acc string)) (let ((output "") (frame nil)) (when (not frame) (when (string-match gud-matlab-marker-regexp-1 gud-marker-acc) (when (not frame) ;; If there is a debug prompt, and no frame currently set, ;; go find one. (let ((url gud-marker-acc) ef el) (cond ((string-match "^error:\\(.*\\),\\([0-9]+\\),\\([0-9]+\\)$" url) (setq ef (substring url (match-beginning 1) (match-end 1)) el (substring url (match-beginning 2) (match-end 2))) ) ((string-match "opentoline('\\([^']+\\)',\\([0-9]+\\),\\([0-9]+\\))" url) (setq ef (substring url (match-beginning 1) (match-end 1)) el (substring url (match-beginning 2) (match-end 2))) ) ;; If we have the prompt, but no match (as above), ;; perhaps it is already dumped out into the buffer. In ;; that case, look back through the buffer. ) (when ef (setq frame (cons ef (string-to-number el))))))) ) ;; This if makes sure that the entirety of an error output is brought in ;; so that matlab-shell-mode doesn't try to display a file that only partially ;; exists in the buffer. Thus, if MATLAB output: ;; error: /home/me/my/mo/mello.m,10,12 ;; All of that is in the buffer, and it goes to mello.m, not just ;; the first half of that file name. ;; The below used to match against the prompt, not \n, but then text that ;; had error: in it for some other reason wouldn't display at all. (if (and matlab-prompt-seen ;; Don't collect during boot (not frame) ;; don't collect debug stuff (let ((start (string-match gud-matlab-marker-regexp-prefix gud-marker-acc))) (and start (not (string-match "\n" gud-marker-acc start)) ;;(not (string-match "^K?>>\\|\\?\\?\\?\\s-Error while evaluating" gud-marker-acc start)) ))) ;; We could be collecting something. Wait for a while. nil ;; Finish off this part of the output. None of our special stuff ;; ends with a \n, so display those as they show up... (while (string-match "^[^\n]*\n" gud-marker-acc) (setq output (concat output (substring gud-marker-acc 0 (match-end 0))) gud-marker-acc (substring gud-marker-acc (match-end 0)))) (setq output (concat output gud-marker-acc) gud-marker-acc "") ;; Check our output for a prompt, and existence of a frame. ;; If t his is true, throw out the debug arrow stuff. (if (and (string-match "^>> $" output) gud-last-last-frame) (progn (setq overlay-arrow-position nil gud-last-last-frame nil gud-overlay-arrow-position nil) (sit-for 0) ))) (if frame (setq gud-last-frame frame)) ;;(message "[%s] [%s]" output gud-marker-acc) output)) (defun gud-matlab-find-file (f) "Find file F when debugging frames in MATLAB." (save-excursion (let* ((realfname (if (string-match "\\.\\(p\\)$" f) (progn (aset f (match-beginning 1) ?m) f) f)) (buf (find-file-noselect realfname))) (set-buffer buf) (if (fboundp 'gud-make-debug-menu) (gud-make-debug-menu)) buf))) (defun matlab-shell-next-matching-input-from-input (n) "Get the Nth next matching input from for the command line." (interactive "p") (matlab-shell-previous-matching-input-from-input (- n))) (defun matlab-shell-previous-matching-input-from-input (n) "Get the Nth previous matching input from for the command line." (interactive "p") (end-of-line) ;; patch: Mark Histed (if (comint-after-pmark-p) (if (memq last-command '(matlab-shell-previous-matching-input-from-input matlab-shell-next-matching-input-from-input)) ;; This hack keeps the cycling working well. (let ((last-command 'comint-previous-matching-input-from-input)) (comint-next-matching-input-from-input (- n))) ;; first time. (comint-next-matching-input-from-input (- n))) ;; If somewhere else, just move around. (previous-line n))) (defun matlab-shell-delete-backwards-no-prompt (&optional arg) "Delete one char backwards without destroying the matlab prompt. Optional argument ARG describes the number of chars to delete." (interactive "P") (let ((promptend (save-excursion (beginning-of-line) (if (looking-at "K?>> ") (match-end 0) (point)))) (numchars (if (integerp arg) (- arg) -1))) (if (<= promptend (+ (point) numchars)) (delete-char numchars) (error "Beginning of line")))) (defun matlab-shell-completion-list (str) "Get a list of completions from MATLAB. STR is a substring to complete." (save-excursion (let* ((msbn (matlab-shell-buffer-barf-not-running)) (cmd (concat "matlabMCRprocess = com.mathworks.jmi.MatlabMCR;" "matlabMCRprocess.mtFindAllTabCompletions('" str "'), clear('matlabMCRprocess');")) (comint-scroll-show-maximum-output nil) output (completions nil)) (set-buffer msbn) (if (not (matlab-on-prompt-p)) (error "MATLAB shell must be non-busy to do that")) (setq output (matlab-shell-collect-command-output cmd)) ;; Debug (string-match "ans =" output) (setq output (substring output (match-end 0))) ;; Parse the output string. (while (string-match "'" output) ;; Hack off the preceeding quote (setq output (substring output (match-end 0))) (string-match "'" output) ;; we are making a completion list, so that is a list of lists. (setq completions (cons (list (substring output 0 (match-beginning 0))) completions) output (substring output (match-end 0)))) ;; Return them (nreverse completions)))) (defun matlab-shell-which-fcn (fcn) "Get the location of FCN's M file. Returns an alist: ( LOCATION . BUILTINFLAG ) LOCATION is a string indicating where it is, and BUILTINFLAG is non-nil if FCN is a builtin." (save-excursion (let* ((msbn (matlab-shell-buffer-barf-not-running)) (cmd (concat "which " fcn)) (comint-scroll-show-maximum-output nil) output builtin ) (set-buffer msbn) (if (not (matlab-on-prompt-p)) (error "MATLAB shell must be non-busy to do that")) (setq output (matlab-shell-collect-command-output cmd)) ;; BUILT-IN (cond ((string-match "built-in (\\([^)]+\\))" output) (cons (concat (substring output (match-beginning 1) (match-end 1)) ".m") t)) ;; Error ((string-match "not found" output) nil) ;; JUST AN M FILE (t (string-match "$" output) (cons (substring output 0 (match-beginning 0)) nil)))))) (defun matlab-shell-matlabroot () "Get the location of of this shell's root. Returns a string path to the root of the executing MATLAB." (save-excursion (let* ((msbn (matlab-shell-buffer-barf-not-running)) (cmd "disp(matlabroot)") (comint-scroll-show-maximum-output nil) output builtin ) (set-buffer msbn) (if (and (boundp 'matlab-shell-matlabroot-run) matlab-shell-matlabroot-run) matlab-shell-matlabroot-run ;; If we haven't cache'd it, calculate it now. (if (not (matlab-on-prompt-p)) (error "MATLAB shell must be non-busy to do that")) (setq output (matlab-shell-collect-command-output cmd)) (string-match "$" output) (substring output 0 (match-beginning 0)))))) (defvar matlab-shell-window-exists-for-display-completion-flag nil "Non-nil means there was an 'other-window' available when `display-completion-list' is called.") (defun matlab-shell-tab () "Send [TAB] to the currently running matlab process and retrieve completion." (interactive) (if (not matlab-shell-ask-MATLAB-for-completions) (call-interactively 'comint-dynamic-complete-filename) (if (not (matlab-on-prompt-p)) (error "Completions not available")) (if nil ;; For older versions of MATLAB that don't have TAB ;; completion. (call-interactively 'comint-dynamic-complete-filename) ;; Save the old command (goto-char (point-max)) (let ((inhibit-field-text-motion t)) (beginning-of-line)) (re-search-forward comint-prompt-regexp) (let* ((lastcmd (buffer-substring (point) (matlab-point-at-eol))) (tempcmd lastcmd) (completions nil) (limitpos nil)) ;; search for character which limits completion, and limit command to it (setq limitpos (if (string-match ".*\\([( /[.,;=']\\)" lastcmd) (1+ (match-beginning 1)) 0)) (setq lastcmd (substring lastcmd limitpos)) ;; Whack the old command so we can insert it back later. (delete-region (+ (point) limitpos) (matlab-point-at-eol)) ;; double every single quote (while (string-match "[^']\\('\\)\\($\\|[^']\\)" tempcmd) (setq tempcmd (replace-match "''" t t tempcmd 1))) ;; collect the list (setq completions (matlab-shell-completion-list tempcmd)) (goto-char (point-max)) (if (eq (length completions) 1) ;; If there is only one, then there is an obvious thing to do. (progn (insert (car (car completions))) ;; kill completions buffer if still visible (matlab-shell-tab-hide-completions)) (let ((try (try-completion lastcmd completions))) ;; Insert in a good completion. (cond ((or (eq try nil) (eq try t) (and (stringp try) (string= try lastcmd))) (insert lastcmd) ;; Before displaying the completions buffer, check to see if ;; the completions window is already displayed, or if there is ;; a next window to display. This determines how to remove the ;; completions later. (if (get-buffer-window "*Completions*") nil ;; Recycle old value of the display flag. ;; Else, reset this variable. (setq matlab-shell-window-exists-for-display-completion-flag ;; Else, it isn't displayed, save an action. (if (eq (next-window) (selected-window)) ;; If there is no other window, the post action is ;; to delete. 'delete ;; If there is a window to display, the post ;; action is to bury. 'bury))) (with-output-to-temp-buffer "*Completions*" (display-completion-list (mapcar 'car completions) lastcmd))) ((stringp try) (insert try) (matlab-shell-tab-hide-completions)) (t (insert lastcmd)))) ))))) (defun matlab-shell-tab-hide-completions () "Hide any completion windows for `matlab-shell-tab'." (cond ((eq matlab-shell-window-exists-for-display-completion-flag 'delete) (when (get-buffer "*Completions*") (delete-windows-on "*Completions*"))) ((eq matlab-shell-window-exists-for-display-completion-flag 'bury) (let ((orig (selected-window)) (bw nil)) (while (setq bw (get-buffer-window "*Completions*")) (select-window bw) (bury-buffer)) (select-window orig))) ) ;; Reset state. (setq matlab-shell-window-exists-for-display-completion-flag nil)) ;;; MATLAB mode Shell commands ================================================ (defun matlab-show-matlab-shell-buffer () "Switch to the buffer containing the matlab process." (interactive) (let ((msbn (concat "*" matlab-shell-buffer-name "*"))) (if (get-buffer msbn) (switch-to-buffer-other-window msbn) (message "There is not an active MATLAB process.")))) (defvar matlab-shell-save-and-go-history '("()") "Keep track of parameters passed to the MATLAB shell.") (defun matlab-shell-add-to-input-history (string) "Add STRING to the input-ring and run `comint-input-filter-functions' on it. Similar to `comint-send-input'." (if (and (funcall comint-input-filter string) (or (null comint-input-ignoredups) (not (ring-p comint-input-ring)) (ring-empty-p comint-input-ring) (not (string-equal (ring-ref comint-input-ring 0) string)))) (ring-insert comint-input-ring string)) (run-hook-with-args 'comint-input-filter-functions (concat string "\n")) (if (boundp 'comint-save-input-ring-index);only bound in GNU emacs (setq comint-save-input-ring-index comint-input-ring-index)) (setq comint-input-ring-index nil)) (defun matlab-shell-save-and-go () "Save this M file, and evaluate it in a MATLAB shell." (interactive) (if (not (eq major-mode 'matlab-mode)) (error "Save and go is only useful in a MATLAB buffer!")) (if (not (buffer-file-name (current-buffer))) (call-interactively 'write-file)) (let ((fn-name (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))) (msbn (concat "*" matlab-shell-buffer-name "*")) (param "")) (save-buffer) ;; Do we need parameters? (if (save-excursion (goto-char (point-min)) (end-of-line) (forward-sexp -1) (looking-at "([a-zA-Z]")) (setq param (read-string "Parameters: " (car matlab-shell-save-and-go-history) 'matlab-shell-save-and-go-history))) (if (matlab-with-emacs-link) ;; Execute the current file in MATLAB (matlab-eei-run) ;; No buffer? Make it! (if (not (get-buffer msbn)) (matlab-shell)) ;; Ok, now fun the function in the matlab shell (if (get-buffer-window msbn t) (select-window (get-buffer-window msbn t)) (switch-to-buffer (concat "*" matlab-shell-buffer-name "*"))) (let ((cmd (concat fn-name " " param))) (matlab-shell-add-to-input-history cmd) (matlab-shell-send-string (concat cmd "\n")))))) (defun matlab-shell-run-region (beg end &optional noshow) "Run region from BEG to END and display result in MATLAB shell. If NOSHOW is non-nil, replace newlines with commas to suppress output. This command requires an active MATLAB shell." (interactive "r") (if (> beg end) (let (mid) (setq mid beg beg end end mid))) (let ((command (let ((str (concat (buffer-substring beg end) "\n"))) ;; Remove comments (with-temp-buffer (insert str) (goto-char (point-min)) (while (search-forward "%" nil t) (when (not (matlab-cursor-in-string)) (delete-region (1- (point)) (matlab-point-at-eol)))) (setq str (buffer-substring-no-properties (point-min) (point-max)))) (while (string-match "\n\\s-*\n" str) (setq str (concat (substring str 0 (match-beginning 0)) "\n" (substring str (match-end 0))))) (when noshow ;; Remove continuations (while (string-match (concat "\\s-*" (regexp-quote matlab-elipsis-string) "\\s-*\n") str) (setq str (replace-match " " t t str))) (while (string-match "\n" str) (setq str (replace-match ", " t t str))) (setq str (concat str "\n"))) str)) (msbn nil) (lastcmd) (inhibit-field-text-motion t)) (if (matlab-with-emacs-link) ;; Run the region w/ Emacs Link (matlab-eei-eval-region beg end) (save-excursion (setq msbn (matlab-shell-buffer-barf-not-running)) (set-buffer msbn) (if (not (matlab-on-prompt-p)) (error "MATLAB shell must be non-busy to do that")) ;; Save the old command (beginning-of-line) (re-search-forward comint-prompt-regexp) (setq lastcmd (buffer-substring (point) (matlab-point-at-eol))) (delete-region (point) (matlab-point-at-eol)) ;; We are done error checking, run the command. (matlab-shell-send-string command) (insert lastcmd)) (set-buffer msbn) (goto-char (point-max)) (display-buffer msbn nil "visible")) )) (defun matlab-shell-run-cell () "Run the cell the cursor is in." (interactive) (let ((start (save-excursion (forward-page -1) (if (looking-at "function") (error "You are not in a cell. Try `matlab-shell-save-and-go' instead")) (when (matlab-ltype-comm) ;; Skip over starting comment from the current cell. (matlab-end-of-command 1) (end-of-line) (forward-char 1)) (point))) (end (save-excursion (forward-page 1) (when (matlab-ltype-comm) (beginning-of-line) (forward-char -1)) (point)))) (matlab-shell-run-region start end t))) (defun matlab-shell-run-region-or-line () "Run region from BEG to END and display result in MATLAB shell. pIf region is not active run the current line. This command requires an active MATLAB shell." (interactive) (if (and transient-mark-mode mark-active) (matlab-shell-run-region (mark) (point)) (matlab-shell-run-region (matlab-point-at-bol) (matlab-point-at-eol)))) ;;; MATLAB Shell Commands ===================================================== (defun matlab-read-word-at-point () "Get the word closest to point, but do not change position. Has a preference for looking backward when not directly on a symbol. Snatched and hacked from dired-x.el" (let ((word-chars "a-zA-Z0-9_") (bol (matlab-point-at-bol)) (eol (matlab-point-at-eol)) start) (save-excursion ;; First see if just past a word. (if (looking-at (concat "[" word-chars "]")) nil (skip-chars-backward (concat "^" word-chars "{}()\[\]") bol) (if (not (bobp)) (backward-char 1))) (if (numberp (string-match (concat "[" word-chars "]") (char-to-string (following-char)))) (progn (skip-chars-backward word-chars bol) (setq start (point)) (skip-chars-forward word-chars eol)) (setq start (point))) ; If no found, return empty string (buffer-substring start (point))))) (defun matlab-read-line-at-point () "Get the line under point, if command line." (if (eq major-mode 'matlab-shell-mode) (save-excursion (let ((inhibit-field-text-motion t)) (beginning-of-line) (if (not (looking-at (concat comint-prompt-regexp))) "" (search-forward-regexp comint-prompt-regexp) (buffer-substring (point) (matlab-point-at-eol))))) (save-excursion ;; In matlab buffer, find all the text for a command. ;; so back over until there is no more continuation. (while (save-excursion (forward-line -1) (matlab-lattr-cont)) (forward-line -1)) ;; Go forward till there is no continuation (beginning-of-line) (let ((start (point))) (while (matlab-lattr-cont) (forward-line 1)) (end-of-line) (buffer-substring start (point)))))) (defun matlab-non-empty-lines-in-string (str) "Return number of non-empty lines in STR." (let ((count 0) (start 0)) (while (string-match "^.+$" str start) (setq count (1+ count) start (match-end 0))) count)) (defun matlab-output-to-temp-buffer (buffer output) "Print output to temp buffer, or a message if empty string. BUFFER is the buffer to output to, and OUTPUT is the text to insert." (let ((lines-found (matlab-non-empty-lines-in-string output))) (cond ((= lines-found 0) (message "(MATLAB command completed with no output)")) ((= lines-found 1) (string-match "^.+$" output) (message (substring output (match-beginning 0)(match-end 0)))) (t (with-output-to-temp-buffer buffer (princ output)) (save-excursion (set-buffer buffer) (matlab-shell-help-mode)))))) (defun matlab-shell-run-command (command) "Run COMMAND and display result in a buffer. This command requires an active MATLAB shell." (interactive (list (read-from-minibuffer "MATLAB command line: " (cons (matlab-read-line-at-point) 0)))) (let ((doc (matlab-shell-collect-command-output command))) (matlab-output-to-temp-buffer "*MATLAB Help*" doc))) (defun matlab-shell-describe-variable (variable) "Get the contents of VARIABLE and display them in a buffer. This uses the WHOS (MATLAB 5) command to find viable commands. This command requires an active MATLAB shell." (interactive (list (read-from-minibuffer "MATLAB variable: " (cons (matlab-read-word-at-point) 0)))) (let ((doc (matlab-shell-collect-command-output (concat "whos " variable)))) (matlab-output-to-temp-buffer "*MATLAB Help*" doc))) (defun matlab-shell-describe-command (command) "Describe COMMAND textually by fetching it's doc from the MATLAB shell. This uses the lookfor command to find viable commands. This command requires an active MATLAB shell." (interactive (let ((fn (matlab-function-called-at-point)) val) (setq val (read-string (if fn (format "Describe function (default %s): " fn) "Describe function: "))) (if (string= val "") (list fn) (list val)))) (let ((doc (matlab-shell-collect-command-output (concat "help " command)))) (matlab-output-to-temp-buffer "*MATLAB Help*" doc))) (defun matlab-shell-apropos (matlabregex) "Look for any active commands in MATLAB matching MATLABREGEX. This uses the lookfor command to find viable commands." (interactive (list (read-from-minibuffer "MATLAB command subexpression: " (cons (matlab-read-word-at-point) 0)))) (let ((ap (matlab-shell-collect-command-output (concat "lookfor " matlabregex)))) (matlab-output-to-temp-buffer "*MATLAB Apropos*" ap))) (defun matlab-on-prompt-p () "Return t if we MATLAB can accept input." (save-excursion (let ((inhibit-field-text-motion t)) (goto-char (point-max)) (beginning-of-line) (looking-at comint-prompt-regexp)))) (defun matlab-on-empty-prompt-p () "Return t if we MATLAB is on an empty prompt." (save-excursion (let ((inhibit-field-text-motion t)) (goto-char (point-max)) (beginning-of-line) (looking-at (concat comint-prompt-regexp "\\s-*$"))))) (defun matlab-shell-buffer-barf-not-running () "Return a running MATLAB buffer iff it is currently active." (or (matlab-shell-active-p) (error "You need to run the command `matlab-shell' to do that!"))) (defun matlab-shell-collect-command-output (command) "If there is a MATLAB shell, run the MATLAB COMMAND and return it's output. It's output is returned as a string with no face properties. The text output of the command is removed from the MATLAB buffer so there will be no indication that it ran." (let ((msbn (matlab-shell-buffer-barf-not-running)) (pos nil) (str nil) (lastcmd) (inhibit-field-text-motion t)) (save-excursion (set-buffer msbn) (if (not (matlab-on-prompt-p)) (error "MATLAB shell must be non-busy to do that")) ;; Save the old command (goto-char (point-max)) (beginning-of-line) (re-search-forward comint-prompt-regexp) (setq lastcmd (buffer-substring (point) (matlab-point-at-eol))) (delete-region (point) (matlab-point-at-eol)) ;; We are done error checking, run the command. (setq pos (point)) (comint-simple-send (get-buffer-process (current-buffer)) (concat command "\n")) ;;(message "MATLAB ... Executing command.") (goto-char (point-max)) (while (or (>= (+ pos (string-width command)) (point)) (not (matlab-on-empty-prompt-p))) (accept-process-output (get-buffer-process (current-buffer))) (goto-char (point-max)) ;;(message "MATLAB reading...") ) ;;(message "MATLAB reading...done") (save-excursion (goto-char pos) (beginning-of-line) (setq str (buffer-substring-no-properties (save-excursion (goto-char pos) (beginning-of-line) (forward-line 1) (point)) (save-excursion (goto-char (point-max)) (beginning-of-line) (point)))) (delete-region pos (point-max))) (insert lastcmd)) str)) (defun matlab-shell-send-string (string) "Send STRING to the currently running matlab process." (if (not matlab-shell-echoes) (let ((proc (get-buffer-process (current-buffer)))) (goto-char (point-max)) (insert string) (set-marker (process-mark proc) (point)))) (comint-send-string (get-buffer-process (current-buffer)) string)) (defun matlab-url-at (p) "Return the matlab-url overlay at P, or nil." (let ((url nil) (o (matlab-overlays-at p))) (while (and o (not url)) (setq url (matlab-overlay-get (car o) 'matlab-url) o (cdr o))) url)) (defun matlab-url-stack-top-at (p) "Return the matlab-url overlay at P, or nil." (let ((url nil) (o (matlab-overlays-at p))) (while (and o (not url)) (setq url (or (matlab-overlay-get (car o) 'first-in-error-stack) (matlab-overlay-get (car o) 'matlab-url)) o (cdr o))) url)) (defun matlab-shell-previous-matlab-url (&optional stacktop) "Find a previous occurrence of an overlay with a MATLAB URL. If STACKTOP is non-nil, then also get the top of some stack, which didn't show up in reverse order." (save-excursion (let ((url nil) (o nil) (p (point))) (while (and (not url) (setq p (matlab-previous-overlay-change p)) (not (eq p (point-min)))) (setq url (if stacktop (matlab-url-stack-top-at p) (matlab-url-at p)))) url))) (defun matlab-find-other-window-file-line-column (ef el ec &optional debug) "Find file EF in other window and to go line EL and 1-basec column EC. If DEBUG is non-nil, then setup GUD debugging features." (cond ((file-exists-p ef) nil);; keep ef the same ((file-exists-p (concat ef ".m")) (setq ef (concat ef ".m"))) ;; Displayed w/out .m? ((string-match ">" ef) (setq ef (concat (substring ef 0 (match-beginning 0)) ".m"))) ) (find-file-other-window ef) (goto-line (string-to-number el)) (when debug (setq gud-last-frame (cons (buffer-file-name) (string-to-number el))) (gud-display-frame)) (setq ec (string-to-number ec)) (if (> ec 0) (forward-char (1- ec)))) (defun matlab-find-other-window-via-url (url &optional debug) "Find other window using matlab URL and optionally set DEBUG cursor." (cond ((string-match "^error:\\(.*\\),\\([0-9]+\\),\\([0-9]+\\)$" url) (let ((ef (substring url (match-beginning 1) (match-end 1))) (el (substring url (match-beginning 2) (match-end 2))) (ec (substring url (match-beginning 3) (match-end 3)))) (matlab-find-other-window-file-line-column ef el ec debug))) ((string-match "opentoline('\\([^']+\\)',\\([0-9]+\\),\\([0-9]+\\))" url) (let ((ef (substring url (match-beginning 1) (match-end 1))) (el (substring url (match-beginning 2) (match-end 2))) (ec (substring url (match-beginning 3) (match-end 3)))) (matlab-find-other-window-file-line-column ef el ec debug))) ((string-match "^matlab: *\\(.*\\)$" url) (process-send-string (get-buffer-process gud-comint-buffer) (concat (substring url (match-beginning 1) (match-end 1)) "\n"))))) (defun matlab-shell-last-error () "In the MATLAB interactive buffer, find the last MATLAB error, and go there. To reference old errors, put the cursor just after the error text." (interactive) (catch 'done (let ((url (matlab-shell-previous-matlab-url t))) (if url (progn (matlab-find-other-window-via-url url) (throw 'done nil)) (save-excursion (end-of-line) ;; In case we are before the linenumber 1998/06/05 16:54sk (if (not (re-search-backward gud-matlab-error-regexp nil t)) (error "No errors found!")) (let ((ef (buffer-substring-no-properties (match-beginning 2) (match-end 2))) (el (buffer-substring-no-properties (match-beginning 3) (match-end 3)))) (matlab-find-other-window-file-line-column ef el "0"))))))) (defun matlab-shell-html-click (e) "Go to the error at the location of event E." (interactive "e") (mouse-set-point e) (matlab-shell-html-go)) (defun matlab-shell-html-go () "Go to the error at the location `point'." (interactive) (let ((url (matlab-url-at (point)))) (if url (matlab-find-other-window-via-url url)))) (defun matlab-shell-dbstop-error () "Stop on errors." (interactive) (comint-send-string (get-buffer-process (current-buffer)) "dbstop if error\n")) (defun matlab-shell-dbclear-error () "Don't stop on errors." (interactive) (comint-send-string (get-buffer-process (current-buffer)) "dbclear if error\n")) (defun matlab-shell-demos () "MATLAB demos." (interactive) (comint-send-string (get-buffer-process (current-buffer)) "demo\n")) (defun matlab-shell-close-figures () "Close any open figures." (interactive) (comint-send-string (get-buffer-process (current-buffer)) "close all\n")) (defun matlab-shell-close-current-figure () "Close current figure." (interactive) (comint-send-string (get-buffer-process (current-buffer)) "delete(gcf)\n")) (defun matlab-shell-exit () "Exit MATLAB shell." (interactive) (comint-send-string (get-buffer-process (current-buffer)) "exit\n") (kill-buffer nil)) ;;; matlab-shell based Topic Browser and Help ================================= (defcustom matlab-shell-topic-mode-hook nil "*MATLAB shell topic hook." :group 'matlab-shell :type 'hook) (defvar matlab-shell-topic-current-topic nil "The currently viewed topic in a MATLAB shell topic buffer.") (defun matlab-shell-topic-browser () "Create a topic browser by querying an active MATLAB shell using HELP. Maintain state in our topic browser buffer." (interactive) ;; Reset topic browser if it doesn't exist. (if (not (get-buffer "*MATLAB Topic*")) (setq matlab-shell-topic-current-topic nil)) (let ((b (get-buffer-create "*MATLAB Topic*"))) (switch-to-buffer b) (if (string= matlab-shell-topic-current-topic "") nil (matlab-shell-topic-mode) (matlab-shell-topic-browser-create-contents "")))) (defvar matlab-shell-topic-mouse-face-keywords '(;; These are subtopic fields... ("^\\(\\w+/\\w+\\)[ \t]+-" 1 font-lock-reference-face) ;; These are functions... ("^[ \t]+\\(\\w+\\)[ \t]+-" 1 font-lock-function-name-face) ;; Here is a See Also line... ("[ \t]+See also " ("\\(\\w+\\)\\([,.]\\| and\\|$\\) *" nil nil (1 font-lock-reference-face)))) "These are keywords we also want to put mouse-faces on.") (defvar matlab-shell-topic-font-lock-keywords (append matlab-shell-topic-mouse-face-keywords '(("^[^:\n]+:$" 0 font-lock-keyword-face) ;; These are subheadings... ("^[ \t]+\\([^.\n]+[a-zA-Z.]\\)$" 1 'underline) )) "Keywords useful for highlighting a MATLAB TOPIC buffer.") (defvar matlab-shell-help-font-lock-keywords (append matlab-shell-topic-mouse-face-keywords '(;; Function call examples ("[ \t]\\([A-Z]+\\)\\s-*=\\s-*\\([A-Z]+[0-9]*\\)(" (1 font-lock-variable-name-face) (2 font-lock-function-name-face)) ("[ \t]\\([A-Z]+[0-9]*\\)(" (1 font-lock-function-name-face)) ;; Parameters: Not very accurate, unfortunately. ("[ \t]\\([A-Z]+[0-9]*\\)(" ("'?\\(\\w+\\)'?\\([,)]\\) *" nil nil (1 font-lock-variable-name-face)) ) ;; Reference uppercase words ("\\<\\([A-Z]+[0-9]*\\)\\>" 1 font-lock-reference-face))) "Keywords for regular help buffers.") ;; View-major-mode is an emacs20 thing. This gives us a small compatibility ;; layer. (if (not (fboundp 'view-major-mode)) (defalias 'view-major-mode 'view-mode)) (define-derived-mode matlab-shell-help-mode view-major-mode "M-Help" "Major mode for viewing MATLAB help text. Entry to this mode runs the normal hook `matlab-shell-help-mode-hook'. Commands: \\{matlab-shell-help-mode-map}" (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '((matlab-shell-help-font-lock-keywords) t nil ((?_ . "w")))) ;; This makes sure that we really enter font lock since ;; kill-all-local-variables is not used by old view-mode. (and (boundp 'global-font-lock-mode) global-font-lock-mode (not font-lock-mode) (font-lock-mode 1)) (easy-menu-add matlab-shell-help-mode-menu matlab-shell-help-mode-map) (matlab-shell-topic-mouse-highlight-subtopics) ) (define-key matlab-shell-help-mode-map [return] 'matlab-shell-topic-choose) (define-key matlab-shell-help-mode-map "t" 'matlab-shell-topic-browser) (define-key matlab-shell-help-mode-map "q" 'bury-buffer) (define-key matlab-shell-help-mode-map [(control h) (control m)] matlab-help-map) (if (string-match "XEmacs" emacs-version) (define-key matlab-shell-help-mode-map [button2] 'matlab-shell-topic-click) (define-key matlab-shell-help-mode-map [mouse-2] 'matlab-shell-topic-click)) (easy-menu-define matlab-shell-help-mode-menu matlab-shell-help-mode-map "MATLAB shell topic menu" '("MATLAB Help" ["Describe This Command" matlab-shell-topic-choose t] "----" ["Describe Command" matlab-shell-describe-command t] ["Describe Variable" matlab-shell-describe-variable t] ["Command Apropos" matlab-shell-apropos t] ["Topic Browser" matlab-shell-topic-browser t] "----" ["Exit" bury-buffer t])) (define-derived-mode matlab-shell-topic-mode matlab-shell-help-mode "M-Topic" "Major mode for browsing MATLAB HELP topics. The output of the MATLAB command HELP with no parameters creates a listing of known help topics at a given installation. This mode parses that listing and allows selecting a topic and getting more help for it. Entry to this mode runs the normal hook `matlab-shell-topic-mode-hook'. Commands: \\{matlab-shell-topic-mode-map}" (setq font-lock-defaults '((matlab-shell-topic-font-lock-keywords) t t ((?_ . "w")))) (if (string-match "XEmacs" emacs-version) (setq mode-motion-hook 'matlab-shell-topic-highlight-line)) (easy-menu-add matlab-shell-topic-mode-menu matlab-shell-topic-mode-map) ) (easy-menu-define matlab-shell-topic-mode-menu matlab-shell-topic-mode-map "MATLAB shell topic menu" '("MATLAB Topic" ["Select This Topic" matlab-shell-topic-choose t] ["Top Level Topics" matlab-shell-topic-browser t] "----" ["Exit" bury-buffer t])) (defun matlab-shell-topic-browser-create-contents (subtopic) "Fill in a topic browser with the output from SUBTOPIC." (toggle-read-only -1) (erase-buffer) (insert (matlab-shell-collect-command-output (concat "help " subtopic))) (goto-char (point-min)) (forward-line 1) (delete-region (point-min) (point)) (setq matlab-shell-topic-current-topic subtopic) (if (not (string-match "XEmacs" emacs-version)) (matlab-shell-topic-mouse-highlight-subtopics)) (toggle-read-only 1) ) (defun matlab-shell-topic-click (e) "Click on an item in a MATLAB topic buffer we want more information on. Must be bound to event E." (interactive "e") (mouse-set-point e) (matlab-shell-topic-choose)) (defun matlab-shell-topic-choose () "Choose the topic to expand on that is under the cursor. This can fill the topic buffer with new information. If the topic is a command, use `matlab-shell-describe-command' instead of changing the topic buffer." (interactive) (let ((topic nil) (fun nil) (p (point))) (save-excursion (beginning-of-line) (if (looking-at "^\\w+/\\(\\w+\\)[ \t]+-") (setq topic (match-string 1)) (if (looking-at "^[ \t]+\\(\\(\\w\\|_\\)+\\)[ \t]+-") (setq fun (match-string 1)) (if (and (not (looking-at "^[ \t]+See also")) (not (save-excursion (forward-char -2) (looking-at ",$")))) (error "You did not click on a subtopic, function or reference") (goto-char p) (forward-word -1) (if (not (looking-at "\\(\\(\\w\\|_\\)+\\)\\([.,]\\| and\\|\n\\)")) (error "You must click on a reference") (setq topic (match-string 1))))))) (message "Opening item %s..." (or topic fun)) (if topic (matlab-shell-topic-browser-create-contents (downcase topic)) (matlab-shell-describe-command fun)) )) (defun matlab-shell-topic-mouse-highlight-subtopics () "Put a `mouse-face' on all clickable targets in this buffer." (save-excursion (let ((el matlab-shell-topic-mouse-face-keywords)) (while el (goto-char (point-min)) (while (re-search-forward (car (car el)) nil t) (let ((cd (car (cdr (car el))))) (if (numberp cd) (put-text-property (match-beginning cd) (match-end cd) 'mouse-face 'highlight) (while (re-search-forward (car cd) nil t) (put-text-property (match-beginning (car (nth 3 cd))) (match-end (car (nth 3 cd))) 'mouse-face 'highlight))))) (setq el (cdr el)))))) (defun matlab-shell-topic-highlight-line (event) "A value of `mode-motion-hook' which will highlight topics under the mouse. EVENT is the user mouse event." ;; XEMACS only function (let* ((buffer (event-buffer event)) (point (and buffer (event-point event)))) (if (and buffer (not (eq buffer mouse-grabbed-buffer))) (save-excursion (save-window-excursion (set-buffer buffer) (mode-motion-ensure-extent-ok event) (if (not point) (detach-extent mode-motion-extent) (goto-char point) (end-of-line) (setq point (point)) (beginning-of-line) (if (or (looking-at "^\\w+/\\(\\w+\\)[ \t]+-") (looking-at "^[ \t]+\\(\\(\\w\\|_\\)+\\)[ \t]+-")) (set-extent-endpoints mode-motion-extent (point) point) (detach-extent mode-motion-extent)))))))) ;;; M File path stuff ========================================================= (defun matlab-mode-determine-mfile-path () "Create the path in `matlab-mode-install-path'." (let ((path (file-name-directory matlab-shell-command))) ;; if we don't have a path, find the MATLAB executable on our path. (if (not path) (let ((pl exec-path)) (while (and pl (not path)) (if (and (file-exists-p (concat (car pl) "/" matlab-shell-command)) (not (car (file-attributes (concat (car pl) "/" matlab-shell-command))))) (setq path (car pl))) (setq pl (cdr pl))))) (if (not path) nil ;; When we find the path, we need to massage it to identify where ;; the M files are that we need for our completion lists. (if (string-match "/bin$" path) (setq path (substring path 0 (match-beginning 0)))) ;; Everything stems from toolbox (I think) (setq path (concat path "/toolbox/"))) path)) (defcustom matlab-mode-install-path (list (matlab-mode-determine-mfile-path)) "Base path pointing to the locations of all the m files used by matlab. All directories under each element of `matlab-mode-install-path' are checked, so only top level toolbox directories need be added. Paths should be added in the order in which they should be searched." :group 'matlab-shell :type '(repeat (string :tag "Path: "))) (defun matlab-find-file-under-path (path filename) "Return the pathname or nil of PATH under FILENAME." (if (file-exists-p (concat path filename)) (concat path filename) (let ((dirs (if (file-directory-p path) ;; Not checking as a directory first fails on XEmacs ;; Stelios Kyriacou (directory-files path t nil t))) (found nil)) (while (and dirs (not found)) (if (and (car (file-attributes (car dirs))) ;; require directory readable (file-readable-p (car dirs)) ;; don't redo our path names (not (string-match "/\\.\\.?$" (car dirs))) ;; don't find files in object directories. (not (string-match "@" (car dirs)))) (setq found (matlab-find-file-under-path (concat (car dirs) "/") filename))) (setq dirs (cdr dirs))) found))) (defun matlab-find-file-on-path (filename) "Find FILENAME on the current MATLAB path. The MATLAB path is determined by `matlab-mode-install-path' and the current directory. You must add user-installed paths into `matlab-mode-install-path' if you would like to have them included." (interactive (list (let ((default (matlab-read-word-at-point))) (if default (let ((s (read-string (concat "File (default " default "): ")))) (if (string= s "") default s)) (read-string "File: "))))) (if (string= filename "") (error "You must specify an M file")) (if (not (string-match "\\.m$" filename)) (setq filename (concat filename ".m"))) (let ((fname nil) (dirs matlab-mode-install-path)) (if (file-exists-p (concat default-directory filename)) (setq fname (concat default-directory filename))) (while (and (not fname) dirs) (if (stringp (car dirs)) (progn (message "Searching for %s in %s" filename (car dirs)) (setq fname (matlab-find-file-under-path (car dirs) filename)))) (setq dirs (cdr dirs))) (if fname (find-file fname) (error "File %s not found on any known paths. \ Check `matlab-mode-install-path'" filename)))) (defun matlab-find-file-click (e) "Find the file clicked on with event E on the current path." (interactive "e") (mouse-set-point e) (let ((f (matlab-read-word-at-point))) (if (not f) (error "To find an M file, click on a word")) (matlab-find-file-on-path f))) ;;; matlab-mode debugging ===================================================== (defun matlab-show-line-info () "Display type and attributes of current line. Used in debugging." (interactive) (let ((msg "line-info:") (indent (matlab-calculate-indentation (current-indentation))) (nexti (matlab-next-line-indentation))) (setq msg (concat msg " Line type: " (symbol-name (car indent)) " This Line: " (int-to-string (nth 1 indent)) " Next Line: " (int-to-string nexti))) (if (matlab-lattr-cont) (setq msg (concat msg " w/cont"))) (if (matlab-lattr-comm) (setq msg (concat msg " w/comm"))) (message msg))) (provide 'matlab) ;;; matlab.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/obfusurl.el0000775000000000000000000000734212230377266021440 0ustar ;;; obfusurl.el --- Obfuscate URLs so they aren't spoilers ;; Copyright 2001-2008 by Dave Pearson ;; $Revision: 1.3 $ ;; obfusurl.el is free software distributed under the terms of the GNU ;; General Public Licence, version 2 or (at your option) any later version. ;; For details see the file COPYING. ;;; Commentary: ;; ;; obfusurl.el provides `obfuscate-url', a command that will obfuscate an ;; URL under the cursor. This might be useful if you are writing out an URL ;; for someone but the URL itself might spoil the surprise. ;; ;; For example, this: ;; ;; ;; ;; is turned into this: ;; ;; ;; ;; The latest obfusurl.el is always available from: ;; ;; ;; ;;; THANKS: ;; ;; Andy Sawyer for initially pointing out that URLs with ;; percent escapes already in them would get broken. ;; ;; Kevin Rodgers for suggesting a method of fixing the ;; above. ;; ;; Toby Speight for pointing out that I needed to ;; cater for reserved characters. ;;; INSTALLATION: ;; ;; o Drop obfusurl.el somwehere into your `load-path'. Try your site-lisp ;; directory for example (you might also want to byte-compile the file). ;; ;; o Add the following autoload statement to your ~/.emacs file: ;; ;; (autoload 'obfuscate-url "obfusurl" "Obfuscate URL under point" t) ;;; Code: ;; Things we need: (eval-when-compile (require 'cl)) (require 'thingatpt) ;; Constants. (defconst obfuscate-url-reserved-chars '(?\; ?/ ?? ?: ?@ ?& ?= ?+ ?$ ?,) "Characters reserved by RFC 2396.") ;; Main code. (defun obfuscate-url-hexify-string (string) "Return STRING as percent-escaped hex values. Existing percent-escapes and reserved characters (as defined in RFC 2396) in the text are preserved." (flet ((hexify-string (string) (with-output-to-string (mapc (lambda (c) (princ (format (if (member c obfuscate-url-reserved-chars) "%c" "%%%02x") c))) string)))) (let ((case-fold-search t)) (with-output-to-string (loop for i = 0 then (match-end 0) while (string-match "%[0-9a-f][0-9a-f]" string i) do (princ (concat (hexify-string (substring string i (match-beginning 0))) (match-string 0 string))) finally (princ (hexify-string (substring string i)))))))) (defun obfuscate-url-hexify-url (url) "Return URL as a percent-escaped URL." (let ((trailing-slash (string-match "/$" url)) (split (split-string url "/"))) (with-output-to-string (princ (format "%s//%s" (nth 0 split) (nth 2 split))) (loop for part in (nthcdr 3 split) unless (string= part "") ; Because of XEmacs' `split-string'. do (princ (concat "/" (obfuscate-url-hexify-string part))) finally (when trailing-slash (princ "/")))))) ;;;###autoload (defun obfuscate-url () "Obfuscate an URL under `point'. This might be useful if you're writing out an URL for someone but the URL itself is a spoiler. The URL will still work but it won't be readable (by most mortals anyway)." (interactive "*") (let ((url (thing-at-point 'url))) (if url (let ((bounds (bounds-of-thing-at-point 'url))) (setf (point) (car bounds)) (delete-region (car bounds) (cdr bounds)) (insert (obfuscate-url-hexify-url url))) (error "I can't see an URL here")))) (provide 'obfusurl) ;;; obfusurl.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/session.el0000775000000000000000000021011312230377265021251 0ustar ;;; session.el --- use variables, registers and buffer places across sessions ;; Copyright 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2010 ;; Free Software Foundation, Inc. ;; ;; Author: Christoph Wedler ;; Version: 2.3 (see also `session-version' below) ;; Keywords: session, session management, desktop, data, tools ;; X-URL: http://emacs-session.sourceforge.net/ ;; 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 Licence, 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 . ;;; Commentary: ;; When you start Emacs, package Session restores various variables (e.g., ;; input histories) from your last session. It also provides a menu ;; containing recently changed/visited files and restores the places (e.g., ;; point) of such a file when you revisit it. ;; For details, check or, if you prefer ;; the manual style, the documentation of functions \\[session-save-session] ;; and `session-store-buffer-places'. ;; Bug fixes, bug reports, improvements, and suggestions for the newest version ;; are strongly appreciated. ;;; To-do: ;; One could imaging a combination of desktop.el and session.el. IMHO it is ;; easier to include the remaining features of desktop.el (load some files at ;; startup) into session.el, but desktop.el is already part of Emacs... ;; Anyway, here are some ideas for the combined desktop/session: ;; ;; * Using contexts for buffer positions (idea from bookmark and vc). ;; * Define common code with bookmark to restore buffers from a ;; file-representation (for files, dired, info buffers). ;; * Saving window-configurations? ;;; Installation, private: ;; 1. Make sure to use Emacs-20.2, XEmacs-20.2 or higher. ;; 2. Put this file into your load-path, i.e. any directory mentioned in the ;; value of `load-path'. ;; 3. Byte-compile this file. ;; 4. Load this package by M-x load-library RET session RET ;; 5. Start customization with M-x customize-group RET session RET' or the ;; menu [Options][Customize...]...[Data][Session]. ;; 6. Toggle the [Session Use Package] option to "in use". ;; 7. Save your customization via [Save for future sessions]. ;; 8. If you use both this package and desktop.el, customize the variable ;; `desktop-globals-to-save' to include only the symbol ;; `desktop-missing-file-warning'. ;; Remark: adding some code to your ~/.emacs like in previous versions of ;; session.el still works. ;;; Installation, system- or distribution-wide: ;; The idea here should be to offer new defaults to your users (like using this ;; package), while allowing them to choose otherwise. This is probably best ;; done by defining a custom theme (you probably add other customizations to ;; the custom theme file as well, custom themes might only work with newer ;; Emacsen): ;; 1. Like 1-3 in the private installation instruction. ;; 2. Create the autoloads and custom-loads for session.el and make sure that ;; they are loaded at Emacs startup. You can do it manually by adding the ;; code below to your site.start.el. ;; 3. Define a custom theme like `our-custom' by adding a file called ;; "our-custom-theme.el" with the code below to a directory in the ;; load-path. ;; 4. Enable your custom theme by adding the code below to your default.el. ;; 5. Tell your users that they can disable this package by customizing the ;; user option according to 5-7 in the private installation instruction or ;; by setting `inhibit-default-init' to t. ;; ;; site-start.el, Emacs: ;; (autoload 'session-jump-to-last-change "session" nil t) ;; (autoload 'session-initialize "session" nil t) ;; (eval-after-load "cus-load" ;; '(progn (custom-add-load 'data 'session) ;; (custom-add-load 'session 'session))) ;; ;; site-start.el, XEmacs: ;; (autoload 'session-jump-to-last-change "session" nil t) ;; (autoload 'session-initialize "session" nil t) ;; (custom-add-load 'data 'session) ;; (custom-add-load 'session 'session) ;; ;; our-custom-theme.el, Emacs and XEmacs: ;; (deftheme our-custom "Created 2011-01-15.") ;; (custom-theme-set-variables ;; 'our-custom ;; '(session-use-package t nil (session))) ;; (provide-theme 'our-custom) ;; ;; default.el, Emacs: ;; (enable-theme 'our-custom) ;; ;; default.el, XEmacs: ;; (require-theme 'our-custom) ;;; Code: (provide 'session) (require 'custom) ;; General Emacs/XEmacs-compatibility compile-time macros (eval-when-compile (require 'cl) (defmacro cond-emacs-xemacs (&rest args) (cond-emacs-xemacs-macfn args "`cond-emacs-xemacs' must return exactly one element")) (defun cond-emacs-xemacs-macfn (args &optional msg) (if (atom args) args (and (eq (car args) :@) (null msg) ; (:@ ...spliced...) (setq args (cdr args) msg "(:@ ....) must return exactly one element")) (let ((ignore (if (string-match "XEmacs" emacs-version) :EMACS :XEMACS)) (mode :BOTH) code) (while (consp args) (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args))) (if (atom args) (or args (error "Used selector %s without elements" mode)) (or (eq ignore mode) (push (cond-emacs-xemacs-macfn (car args)) code)) (pop args))) (cond (msg (if (or args (cdr code)) (error msg) (car code))) ((or (null args) (eq ignore mode)) (nreverse code)) (t (nconc (nreverse code) args)))))) ;; Emacs/XEmacs-compatibility `defun': remove interactive "_" for Emacs, use ;; existing functions when they are `fboundp', provide shortcuts if they are ;; known to be defined in a specific Emacs branch (for short .elc) (defmacro defunx (name arglist &rest definition) (let ((xemacsp (string-match "XEmacs" emacs-version)) reuses first) (while (memq (setq first (car definition)) '(:try :emacs-and-try :xemacs-and-try :emacs-only :xemacs-only)) (if (memq first (if xemacsp '(:xemacs-and-try :xemacs-only) '(:emacs-and-try :emacs-only))) (setq reuses (cadr definition) definition nil) (unless (memq first '(:emacs-only :xemacs-only)) (push (cadr definition) reuses))) (setq definition (cddr definition))) (if (and reuses (symbolp reuses)) `(defalias ',name ',reuses) (let* ((docstring (if (stringp (car definition)) (pop definition))) (spec (and (not xemacsp) (eq (car-safe (car definition)) 'interactive) (null (cddar definition)) (cadar definition)))) (if (and (stringp spec) (not (string-equal spec "")) (eq (aref spec 0) ?_)) (setq definition (cons (if (string-equal spec "_") '(interactive) `(interactive ,(substring spec 1))) (cdr definition)))) (if (null reuses) `(defun ,name ,arglist ,docstring ,@(cond-emacs-xemacs-macfn definition)) ;; no dynamic docstring in this case `(eval-and-compile ; no warnings in Emacs (defalias ',name (cond ,@(mapcar (lambda (func) `((fboundp ',func) ',func)) (nreverse reuses)) (t ,(if definition `(lambda ,arglist ,docstring ,@(cond-emacs-xemacs-macfn definition)) 'ignore))))))))))) (eval-when-compile (defvar put-buffer-names-in-file-menu) (defvar menu-bar-files-menu) (defvar yank-menu) (defvar minibuffer-local-ns-map)) ;;;;########################################################################## ;;;; User options, configuration variables ;;;;########################################################################## (defconst session-version "2.3" "Current version of package session. Check for the newest.") ;;;=========================================================================== ;;; Customization and initialization ;;;=========================================================================== (defgroup session nil "Use variables, registers and buffer places across sessions." :group 'data :link '(emacs-commentary-link "session.el") :link '(url-link "http://emacs-session.sourceforge.net/") :prefix "session-") (defgroup session-globals nil "Which variables and registers to save across sessions." :group 'session :prefix "session-") (defgroup session-places nil "Which places are stored for which buffers." :group 'session :prefix "session-") (defgroup session-miscellaneous nil "Miscellaneous configurations of package session." :group 'session :prefix "session-") (defcustom session-initialize t "Whether/what to initialize with function `session-initialize'. If t, do full initialization. Otherwise, the value should be a list with element. To enable, include * `de-saveplace' to de-install package saveplace (is redundant), * `session' to load and save the session file, * `places' to store and use places for files/buffers, * `keys' to setup the default key and mouse bindings, * `menus' to setup the menus." :group 'session-miscellaneous :type '(choice (const :tag "All" t) (set :value (de-saveplace session places keys menus) (const :tag "De-install saveplace" de-saveplace) (const :tag "Load/Save Session" session) (const :tag "Store/Use Places" places) (const :tag "Setup Key/Mouse Bindings" keys) (const :tag "Setup Menus" menus)))) ;;;=========================================================================== ;;; User Options and Configuration: Menu ;;;=========================================================================== (defcustom session-menu-max-size 36 "*Max number of entries which may appear in the session menus." :group 'session-miscellaneous :type 'integer) (defcustom session-file-menu-max-string (if (if (boundp 'put-buffer-names-in-file-menu) put-buffer-names-in-file-menu ; XEmacs nil) ; Emacs: no buffer names in file menu (cons 50 20) 50) "*Max length of strings in submenus of the File menu. Value has the form MAX or (MAX . NAME-THRESHOLD). If the second form is used and the length returned by `buffer-name' is longer than NAME-THRESHOLD, the maximum length will be shortened accordingly. Deprecated: a negative number -MAX stands for (MAX . 0)." :group 'session-miscellaneous :type '(choice (cons (integer :tag "Max. length" 50) (integer :tag "Name threshold" 20)) (integer 50))) (defcustom session-edit-menu-max-string 50 "*Max length of strings in submenus of the Edit menu. See also `session-compact-yank-gap-regexp'. When running under Emacs, customize `yank-menu-length' instead." :group 'session-miscellaneous :type 'integer) (defcustom session-compact-yank-gap-regexp "\\(\n\\|[ \t][ \t][ \t]\\)[ \t\n]*" "*Regexp used when trying to find a gap in a long compact string. If non-nil, leading and trailing whitespaces are not shown, and we try to find a gap consisting matched by this regexp if we have to split the string according to `session-edit-menu-max-string'. This variable has no effect when running under Emacs." :group 'session-miscellaneous :type 'string) (defcustom session-menu-permanent-string " *" "*Marker for permanent files in menu \"File >> Open...recently changed\". A file can set as permanent with prefix argument 3 for a command in `session-kill-buffer-commands'. It can be set as non-permanent with prefix argument -1." :group 'session-miscellaneous :type 'string) ;; TODO: not quite sure whehter this is needed anymore - and if whether ;; it is the best way to exclude certain files. Other options are: ;; based on directory, file name, mode, calling command (defcustom session-set-file-name-exclude-regexp "[/\\]\\.overview\\|[/\\]\\.session\\|News[/\\]" "*Regexp matching file names not to be stored in `file-name-history'. This is used by `session-set-file-name-history'. Value nil means, do not exclude any file." :group 'session-miscellaneous :type '(choice (const nil) regexp)) (defvar session-menu-accelerator-support (and (featurep 'menu-accelerator-support) (fboundp 'submenu-generate-accelerator-spec) 'submenu-generate-accelerator-spec) "Function to generate menu accelerators, or nil if not supported.") ;; calling `abbrev-file-name' on remote files opens the connection! (defvar session-abbrev-inhibit-function ;; this will be renamed with the next release (when minimum is ;; Emacs-22.1, jun 2007 and XEmacs 21.4.12, jan 2003) -> only there we have ;; `define-obsolete-variable-alias' (cond ((fboundp 'file-remote-p) 'file-remote-p) ;; `file-remote-p' doesn't exist in Emacs < 22.1 ((fboundp 'efs-ftp-path) 'efs-ftp-path) ((fboundp 'ange-ftp-ftp-name) 'ange-ftp-ftp-name) ((fboundp 'ange-ftp-ftp-path) 'ange-ftp-ftp-path)) "Function used to determine whether to abbreviate file name. A file name is not abbreviated if this function returns non-nil when called with the file name.") (defvar session-directory-sep-char ; directory-sep-char is not set (if (memq system-type '(ms-dos windows-nt)) ?\\ ?\/) "Directory separator character for session menus.") (defvar session-save-file-coding-system (cond-emacs-xemacs :EMACS 'iso-latin-1-with-esc ;; used `emacs-mule' but this fails with X-Symbol characters... :XEMACS (and (featurep 'mule) 'escape-quoted)) "Coding system to use when writing `session-save-file' if non-nil.") ;;;=========================================================================== ;;; User Options and Configuration: save global variables between sessions ;;;=========================================================================== (defcustom session-globals-max-size 50 "*Maximal number of elements in the global variables. Global variables are only saved if they are non-empty lists. This value can be shadowed by some element in `session-globals-include'. If an element appears more than once in the list, only the first appearance will be stored." :group 'session-globals :type 'integer) (defcustom session-globals-max-string 1024 "*Maximal length of string elements in global variables." :group 'session-globals :type 'integer) (defcustom session-registers-max-string 1024 "*Maximal length of string elements in registers." :group 'session-globals :type 'integer) (defcustom session-save-file (expand-file-name ".session" (cond ((boundp 'user-emacs-directory) user-emacs-directory) ((boundp 'user-init-directory) user-init-directory) (t "~"))) "File to save global variables and registers into. It is saved with coding system `session-save-file-coding-system' at the end of an Emacs session and loaded at the beginning. Used for variables which are typically changed by editing operations, e.g., history and ring variables. See \\[session-save-session] for details." :group 'session-globals :type 'file) (defvar session-old-save-file (expand-file-name ".session" "~")) (defvar session-save-print-spec '(t 2 1024) ;; only for advanced users -> no custom "*TODO") (defcustom session-save-file-modes 384 "Mode bits of session save file, as an integer, or nil. After writing `session-save-file', set mode bits of that file to this value if it is non-nil." :group 'session-globals :type '(choice (const :tag "Don't change" nil) integer)) (defvar session-before-save-hook nil "Hook to be run before `session-save-file' is saved. The functions are called after the global variables are written, directly before the file is actually saved.") (defvar session-after-load-save-file-hook (cond-emacs-xemacs :EMACS (and (default-boundp 'yank-menu) (fboundp 'menu-bar-update-yank-menu) '(session-refresh-yank-menu))) "Hook to be run after `session-save-file' has been loaded. The functions are called when the file has been successfully loaded.") (defcustom session-globals-regexp "-\\(ring\\|history\\)\\'" "Regexp matching global variables to be saved between sessions. Variables in `session-globals-exclude' are not saved, but variables in `session-globals-include' are always saved." :group 'session-globals :type 'regexp) (defcustom session-globals-exclude '(load-history register-alist vc-comment-ring flyspell-auto-correct-ring org-mark-ring planner-browser-file-display-rule-ring) "Global variables not to be saved between sessions. It affects `session-globals-regexp' and `session-globals-include'." :group 'session-globals :type '(repeat variable)) (defcustom session-globals-include '((kill-ring 10) (session-file-alist 100 t) (file-name-history 200) search-ring regexp-search-ring) "Global variables to be saved between sessions. Each element has one of the following forms: NAME, (NAME MAX-SIZE), or (NAME MAX-SIZE ASSOC-P). where NAME is the symbol name of the variable, whose value must be a non-empty list and string elements in this list must be smaller than `session-globals-max-string'. MAX-SIZE (default is `session-globals-max-size') is the maximal number of elements to be saved for this symbol where only the first of equal elements are saved, and ASSOC-P (default is nil) non-nil means that the variable is an alist where the equality of elements is checked on the `car'. If MAX-SIZE or ASSOC-P is non-nil, it can be useful to include a variable in this list even if it matches `session-globals-regexp'. `session-globals-exclude' has no effect on these variables. Do not use this variable to customize your Emacs. Package custom is the appropriate choice for this!" :group 'session-globals :type '(repeat (choice (variable :tag "List var with standard max size") (list variable (integer :tag "Max size") (boolean :tag "Alist"))))) ;;;=========================================================================== ;;; Configuration: registers and local variables ;;;=========================================================================== (defcustom session-registers '((?0 . ?9) ?- ?= ?\\ ?` region (?a . ?z)) "*Registers to be saved in `session-save-file'. Valid elements in this list are: CHAR or (FROM . TO) or `file' or `region' or t. CHAR is a register to save, (FROM . TO) represents a list of registers from FROM to TO. `file' means, only save the following registers in this list if they contain file or file-query references. `region' means, only save registers if they contain a region which has less then `session-registers-max-string' characters. t means, allow both content types. Processing of this list starts with type `file'. Before saving the session files, markers in registers are turned into file references, see variable `session-register-swap-out'." :group 'session-globals :type '(repeat (choice (const :tag "File registers:" file) (const :tag "String registers:" region) (const :tag "Any register type:" t) (character :tag "Register") (cons :tag "Registers" (character :tag "From") (character :tag "To"))))) (defcustom session-locals-include '(overwrite-mode) "Local variables to be stored for specific buffers. See also `session-locals-predicate'. Do not add variables to this list which are more appropriate for local variables in files, i.e., variables which are related to the contents of the file, e.g. `major-mode'!" :group 'session-places :type '(repeat variable)) (defcustom session-locals-predicate 'local-variable-p "Function which must return non-nil for a local variable to be stored. This function is called on all variables in `session-locals-include' with the variable as the first and the current buffer as the second argument. Good values are nil (do not store any variable), `local-variable-p' for local variables, `local-variable-if-set-p' for variables which become local when set, and t (store all variables in `session-locals-include')." :group 'session-places :type '(choice (const :tag "none" nil) (const :tag "All" t) (function-item local-variable-p) (function-item local-variable-if-set-p) (function :tag "Other function"))) (defvar session-register-swap-out (if (fboundp 'register-swap-out) 'register-swap-out 'session-register-swap-out) "Function processing markers in registers when a buffer is killed. If non-nil, this function is added to `kill-buffer-hook'. Good values are `register-swap-out' and the function `session-register-swap-out'.") ;;;=========================================================================== ;;; User Options and Configuration: buffer check--undo, mode+name ;;;=========================================================================== (defcustom session-jump-undo-threshold 240 "*Number of character positions the undo position must be different. Without prefix arg, `session-jump-to-last-change' jumps successively to change positions which differ by at least `session-jump-undo-threshold' characters compared to the current position and previously visited change positions, see `session-jump-undo-remember'." :group 'session-places :type 'integer) (defcustom session-jump-undo-remember 2 "*Number of previously visited change positions checked additionally. See `session-jump-undo-threshold' and `session-jump-to-last-change'." :group 'session-places :type 'integer) ;; Problem if homedir is a symlink (/bar/home -> /net/bar.home) & tmp-mounted ;; (file-truename "~/foo") => "/tmp_mnt/net/bar.home/foo" ;; (abbreviate-file-name "/tmp_mnt/net/bar.home/foo") => "/net/bar.home/foo" ;; I.e., there is a bug in `abbreviate-file-name' on both Emacs and XEmacs ;; (with 2nd arg t). Workaround: use the following in your ~/.emacs: ;;(unless (string= (abbreviate-file-name (file-truename "~") t) "~") ; XEmacs ;; (setq abbreviated-home-dir ;; (let ((abbreviated-home-dir "$foo")) ;; (concat "\\`\\(?:" ;; (regexp-quote (abbreviate-file-name (expand-file-name "~"))) ;; "\\|" ;; (regexp-quote (abbreviate-file-name (file-truename "~"))) ;; "\\)\\(/\\|\\'\\)")))) (defconst session-use-truenames-default (cond-emacs-xemacs :EMACS (string= (abbreviate-file-name (file-truename "~")) "~") :XEMACS (and (string= (abbreviate-file-name (file-truename "~") t) "~") (if (eq system-type 'windows-nt) 'session-xemacs-buffer-local-mswindows-file-p t)))) (defcustom session-use-truenames session-use-truenames-default "*Whether to use the canonical file names when saving/restoring places. If a function, it is called with no argument and returns whether to use the canonical names of files. If non-nil, store and check file names returned by `file-truename'." :group 'session-places :type '(choice (const :tag "No" nil) (const :tag "Yes" t) (function-item :tag "If not starting with \\\\" session-xemacs-buffer-local-mswindows-file-p) (function :tag "Other function"))) (defcustom session-auto-store t "*Determines whether a buffer to be killed passes the mode/name check. This boolean is used by `session-default-buffer-check-p', see `session-buffer-check-function'. A buffer passes the mode/name check, if it passes the mode check, see below, and its file name is not matched by `session-name-disable-regexp', or if fails the mode check and its file name is matched by `session-name-enable-regexp'. A buffer passes the mode check, if this variable is non-nil and its major mode is not a member of `session-mode-disable-list', or if this variable is nil and its major mode is a member of `session-mode-enable-list'." :group 'session-places :type 'boolean) (defcustom session-undo-check 1 "*Determines how a buffer to be killed passes the undo check. Its value is MIN or (MIN . LAST) where MIN is a number. Used by `session-default-buffer-check-p', see `session-buffer-check-function'. To pass the undo check * the length of `buffer-undo-list', assumed to be -1 if no undo information is recorded, must be higher or equal to MIN, * the first form is used or LAST is nil: no further requirement * LAST is `and': additionally, `session-last-change' must be non-nil, i.e., the buffer has been changed previously, * LAST is `or': alternatively, `session-last-change' is non-nil." :group 'session-places :type '(choice (integer :tag "Min no of Changes") (cons (integer :tag "Min no of Changes") (choice :tag "Previous and New Changes" (const :tag "Only consider New Changes" nil) (const :tag "AND previously changed" and) (const :tag "OR previously changed" or))))) (defcustom session-kill-buffer-commands '(kill-this-buffer) "*Commands which kill a buffer. If a prefix argument was provided to any of these commands, it will influence the decision whether to store places for the buffer, see `session-store-buffer-places'. Using commands which use the minibuffer for input, is useless." :group 'session-places :type '(repeat (function :tag "Command"))) (defcustom session-buffer-check-function 'session-default-buffer-check-p "Function which return non-nil if buffer places should be stored. Used by `session-store-buffer-places'. This function is called with the buffer to check as argument. You can also assume that the current buffer is the buffer to check. The default value `session-default-buffer-check-p' returns non-nil, if the buffer * visits an existing readable file, * passes the mode/name check, see `session-auto-store', and * passes the undo check, see `session-undo-check', its default value 1 means: the buffer must have been changed during the session." :group 'session-globals :type '(choice (function-item :tag "Default check" session-default-buffer-check-p) (function :tag "Other function"))) (defcustom session-mode-disable-list '(vm-mode gnus-score-mode message-mode tar-mode) "*Major modes of buffers for which no places are stored. See `session-buffer-check-function'." :group 'session-globals :type '(repeat (function :tag "Major mode"))) (defcustom session-mode-enable-list nil "*Major modes of buffers for which places are stored. See `session-buffer-check-function'." :group 'session-globals :type '(repeat (function :tag "Major mode"))) (defcustom session-name-disable-regexp (concat "\\`" (regexp-quote (if (fboundp 'temp-directory) (temp-directory) "/tmp"))) "*File names of buffers for which no places are stored. See `session-buffer-check-function'." :group 'session-places :type '(choice (const nil) regexp)) (defcustom session-name-enable-regexp nil "*File names of buffers for which places are stored. See `session-buffer-check-function'." :group 'session-places :type '(choice (const nil) regexp)) ;;;;########################################################################## ;;;; Store buffer places and local variables, change register contents ;;;;########################################################################## (defvar session-last-change nil "Position of last change in current buffer. This variable is set by `session-find-file-hook' if the buffer was changed in a previous session. It can also be set by providing an prefix argument to `session-jump-to-last-change'.") (make-variable-buffer-local 'session-last-change) (defvar session-file-alist nil "Alist for places and local variables for some files. It has the form (NAME POINT MARK POINT-MIN POINT-MAX PERMANENT LAST-CHANGE (SYMBOL . VAR) ...) NAME is the file name, POINT is the point position, MARK is the mark position, POINT-MIN and POINT-MAX determine the narrow part if non-nil, PERMANENT is the permanent marker (see `session-buffer-check-function'), LAST-CHANGE is the position of the last change in the previous session or was explicitly set with prefix argument 0 for command \\[session-jump-to-last-change]. Optional pairs (SYMBOL . VAR) are local variables with their values.") (defvar session-jump-to-last-change-counter 0 "Number of repeated invocations of `session-jump-to-last-change'.") (defvar session-jump-to-last-change-recent nil "Current position and previously visited change positions.") ;;;=========================================================================== ;;; Position of last change ;;;=========================================================================== (defun session-undo-position (num pos1 pos2) "Return a previous undo-position or set it. If argument NUM is nil, set `session-last-change' to the recomputed position given by argument POS1 and return POS1 normalized. Otherwise, return a previous undo-position or nil, if no such position can be found. If `session-jump-to-last-change-counter' is nil, the position found is the stored last-change position. If POS1 and POS2 are nil, NUM is the number of undo-boundaries to skip. The position returned is the last change inside the corresponding undo step. Otherwise, NUM is the number of undo entries to skip. The position returned is the last change after these entries outside the range from POS1 to POS2. Increment `session-jump-to-last-change-counter' by the number of entries skipped additionally." (let ((undo-list (and (consp buffer-undo-list) buffer-undo-list)) elem ; element in undo-list, t = not of interest back-list ; used position must be recomputed due to processed elems len ; length of deletion/insertion pos) ; interesting position in undo-list (while (and undo-list (null (car undo-list))) (pop undo-list)) ; ignore undo-boundaries at beg (while undo-list ;; inspect element in undo-list ---------------------------------------- (setq elem (pop undo-list)) (cond ((atom elem) ; marker position (when (or elem pos1) ; undo-boundary is of interest if POS1=nil (if (integerp elem) (setq pos elem ; use point position in undo-list back-list (cons nil back-list)) (setq elem t)))) ; ignore uninteresting elem ((stringp (car elem)) ; deletion: (TEXT . POSITION) (setq pos (abs (cdr elem)) len (length (car elem))) (push (list* pos (+ pos len) (- len)) back-list) (when pos1 ; adopt POS{1,2} if after deletion (if (> pos1 pos) (incf pos1 len)) (if (>= pos2 pos) (incf pos2 len)))) ((integerp (car elem)) ; insertion: (START . END) (setq pos (car elem) len (- (cdr elem) pos)) (push (list* pos pos len) back-list) (when pos1 ; adopt POS{1,2} if after/in insertion (if (> pos1 pos) (setq pos1 (if (> pos1 (cdr elem)) (- pos1 len) pos))) (if (> pos2 pos) (setq pos2 (if (> pos2 (cdr elem)) (- pos2 len) pos)))) (setq pos (cdr elem))) ; point more likely at end of insertion (t (setq elem t))) ;; evaluation element inspection --------------------------------------- (cond ((null num)) ; set POS1 as `session-last-change' ((null pos1) ; looking for undo-boundaries (when (if elem (and (zerop num) pos) (<= (decf num) 0)) (setq undo-list nil))) ((eq elem t) ; uninteresting element (setq pos nil)) ((> num 0) ; interesting, but not the NUM's one (decf num) (setq pos nil)) ((and (<= pos1 pos) (<= pos pos2)) ; inside start region (incf session-jump-to-last-change-counter) (setq pos nil)) (t (setq undo-list nil)))) ;; finalize: evaluate result and process back-list ----------------------- (cond ((null num) ; set POS1 as `session-last-change' (setq session-last-change pos1 pos session-last-change)) ((or (null pos) (> num 0)) ; no position found in undo-list (setq session-jump-to-last-change-counter nil) (setq pos session-last-change)) (t ; pos in undo-list (if session-jump-to-last-change-counter (incf session-jump-to-last-change-counter)) (setq back-list (cdr back-list)))) (when pos (while back-list (setq elem (pop back-list)) (cond ((null elem)) ; integer position in undo-list ((> pos (cadr elem)) ; position after affected region (incf pos (cddr elem))) ; increment/decrement position ((> pos (car elem)) ; position in affected region (setq pos (car elem))))) ; set position to region begin pos))) ;;;###autoload (defun session-jump-to-last-change (&optional arg) "Jump to the position of the last change. Without prefix arg, jump successively to previous change positions which differ by at least `session-jump-undo-threshold' characters by repeated invocation of this command. With prefix argument 0, jump to end of last change. With numeric prefix argument, jump to start of first change in the ARG's undo block in the `buffer-undo-list'. With non-numeric prefix argument (\\[universal-argument] only), set point as oldest change position. It might change slightly if you jump to it due to intermediate insert/delete elements in the `buffer-undo-list'." ;; note: for compatibility reasons (pre v2.2), we use abs(ARG) (interactive "P") (if (consp arg) (let ((pos (session-undo-position nil (point) (point))) (undo-list (and (consp buffer-undo-list) buffer-undo-list))) (setq arg 1) (while (and undo-list (null (car undo-list))) (pop undo-list)) (while undo-list (or (pop undo-list) (incf arg))) (message "Store %d as special last-change position (%s %d %s)" pos (substitute-command-keys "\\[universal-argument]") arg (substitute-command-keys "\\[session-jump-to-last-change]"))) ;; set and restrict previously visited undo positions -------------------- (push (point) session-jump-to-last-change-recent) (if (and (null arg) (eq last-command 'session-jump-to-last-change-seq)) (let ((recent (nthcdr session-jump-undo-remember session-jump-to-last-change-recent))) (if recent (setcdr recent nil))) (setcdr session-jump-to-last-change-recent nil) ; only point (setq session-jump-to-last-change-counter 0)) (let (pos) (if arg (setq pos (session-undo-position (abs (prefix-numeric-value arg)) nil nil)) ;; compute position, compare it with positions in ;; `session-jump-to-last-change-recent' (let ((recent session-jump-to-last-change-recent) old pos1 pos2) (setq pos (point)) (while recent ; at least point is there (setq old (pop recent)) (setq pos1 (- pos session-jump-undo-threshold) pos2 (+ pos session-jump-undo-threshold)) (when (and (<= pos1 old) (<= old pos2)) (setq pos (session-undo-position session-jump-to-last-change-counter pos1 pos2)) (setq recent (and pos session-jump-to-last-change-counter session-jump-to-last-change-recent)))))) (cond ((null pos) (message (if (or arg (atom buffer-undo-list)) "Do not know position of last change" "Do not know position of last distant change"))) ((< pos (point-min)) (goto-char (point-min)) (message "Change position outside visible region")) ((> pos (point-max)) (goto-char (point-max)) (message "Change position outside visible region")) (t (goto-char pos) (cond ((null session-jump-to-last-change-counter) (message "Jumped to stored last-change position")) ((null arg) (setq this-command 'session-jump-to-last-change-seq)))))))) ;;;=========================================================================== ;;; Yank menu (Emacs: refresh existing menu, XEmacs: do our own) ;;;=========================================================================== ;; this function should be defined in menu-bar.el... (defunx session-refresh-yank-menu () :xemacs-only ignore "Refresh `yank-menu' according to `kill-ring'." (when (and (default-boundp 'yank-menu) (fboundp 'menu-bar-update-yank-menu)) (let ((killed (reverse (default-value 'kill-ring)))) (while killed (menu-bar-update-yank-menu (pop killed) nil))))) (defun session-yank (arg) "Reinsert the last stretch of killed text, like \\[yank]. Calls `yank' with argument ARG and with `interprogram-paste-function' bound to nil." (interactive "*p") (let ((interprogram-paste-function nil)) ;#dynamic (yank arg))) (defun session-popup-yank-menu (event) ;; checkdoc-params: (event) "Pop up a menu for inserting items in `kill-ring'." (interactive "e") (when kill-ring (setq this-command last-command) (popup-menu '("Select and Paste" :filter session-yank-menu-filter)))) (defun session-yank-menu-filter (menu-items) ;; checkdoc-params: (menu-items) "Return a menu for inserting items in `kill-ring'." (let ((menu nil) (ring nil) (max session-menu-max-size) (len (length kill-ring)) (half-str-len (/ (- session-edit-menu-max-string 4) 2)) (i 0) (active (not buffer-read-only)) elem (interprogram-paste-function nil)) ;#dynamic ;; Traversing (append kill-ring-yank-pointer kill-ring) instead indexing ;; (current-kill INDEX) would be probably more efficient, but would be a ;; very low-level hack (while (and (< i len) (> max 0)) (setq elem (current-kill i t) i (1+ i)) (unless (or (assoc elem ring) (string-match "\\`[ \t\n]*\\'" elem)) (push (cons elem i) ring) (setq max (1- max)))) (while ring (setq elem (car ring) ring (cdr ring)) (push (session-yank-string (car elem) half-str-len (list 'session-yank (cdr elem)) active) menu)) (session-menu-maybe-accelerator menu-items menu))) (defun session-yank-string (string half-len-str callback active) ;; checkdoc-order: nil "Return menu item STRING with callback CALLBACK. If ACTIVE is non-nil, the item is active. HALF-LEN-STR is the length of the two parts of a abbreviated menu item name." (let ((beg (or (and session-compact-yank-gap-regexp (string-match "\\`[ \t\n]+" string) (match-end 0)) 0)) (end (or (and session-compact-yank-gap-regexp (string-match "[ \t\n]+\\'" string)) (length string)))) (vector (if (> (- end beg) session-edit-menu-max-string) (let ((gap (and session-compact-yank-gap-regexp (string-match session-compact-yank-gap-regexp string (- end half-len-str)) (match-end 0)))) (if (and gap (< gap (- end 3))) (setq half-len-str (- (+ half-len-str half-len-str gap) end)) (setq gap (- end half-len-str))) (concat (session-subst-char-in-string ?\t ?\ (substring string beg (+ beg half-len-str)) t) " ... " (session-subst-char-in-string ?\t ?\ (substring string gap end) t))) (session-subst-char-in-string ?\t ?\ (substring string beg end) t)) callback active))) ;; from EMACS-20.4/lisp/subr.el: (defunx session-subst-char-in-string (fromchar tochar string &optional inplace) :try subst-char-in-string "Replace FROMCHAR with TOCHAR in STRING each time it occurs. Unless optional argument INPLACE is non-nil, return a new string." (let ((i (length string)) (newstr (if inplace string (copy-sequence string)))) (while (> i 0) (setq i (1- i)) (if (eq (aref newstr i) fromchar) (aset newstr i tochar))) newstr)) ;;;=========================================================================== ;;; Menu filters (XEmacs only) ;;;=========================================================================== (defun session-file-opened-recompute () (interactive) (session-file-changed-recompute t)) (defun session-file-changed-recompute (&optional for-opened) (interactive) (let ((session-use-package t)) ;#dynamic (save-excursion (dolist (buffer (nreverse (buffer-list))) (set-buffer buffer) (when buffer-file-name (condition-case nil ; potential errors with remote files (if for-opened (session-set-file-name-history) (session-store-buffer-places 1)) (error nil))))))) (defun session-file-opened-menu-filter (menu-items) ;; checkdoc-params: (menu-items) "This is the menu filter for \"File >> Open...recently visited\". See `session-file-changed-menu-filter'." (session-file-changed-menu-filter menu-items file-name-history)) (defun session-file-changed-menu-filter (menu-items &optional files find-fn) ;; checkdoc-params: (menu-items) "This is the menu filter for \"File >> Open...recently changed\". It dynamically creates a list of files to use as the contents of the menu. The files are taken from FILES or `session-file-alist'. It doesn't show the same name twice and shows `session-menu-max-size' names at most. FIND-FN or \\[find-file] is the function to use when selecting a file in the menu." (or files (setq files session-file-alist)) (or find-fn (setq find-fn 'session-find-file)) (let ((excl nil) (menu nil) (i session-menu-max-size) (max-string (max (cond ((natnump session-file-menu-max-string) session-file-menu-max-string) ((integerp session-file-menu-max-string) (- 0 session-file-menu-max-string (length (buffer-name)))) ((consp session-file-menu-max-string) (- (car session-file-menu-max-string) (max (- (length (buffer-name)) (cdr session-file-menu-max-string)) 0))) (t 50)) 16))) (while (and files (> i 0)) (let ((name (pop files)) desc) (when (consp name) (setq desc name name (car name))) (setq name (session-abbrev-file-name (directory-file-name name))) (unless (member name excl) (setq i (1- i)) (push name excl) (push (vector (or (session-file-prune-name name max-string) name) (list find-fn name) :keys (concat (and (sixth desc) "p") (let ((buf (get-file-buffer name))) (when buf (with-current-buffer buf (if (consp buffer-undo-list) (if (buffer-modified-p) "c" "s") (if buffer-read-only "r" "v"))))))) menu)))) (session-menu-maybe-accelerator menu-items (nreverse menu)))) (defun session-file-prune-name (elem max-string) (when (> (length elem) max-string) (let* ((sep-string (char-to-string session-directory-sep-char)) (components (split-string elem (regexp-quote sep-string)))) (or (cdr components) ; successful split (eq session-directory-sep-char ?\/) ; already Unix separator (setq sep-string "/" components (split-string elem (regexp-quote sep-string)))) (let* ((prefix (if (< (length (car components)) 3) ; e.g. "~" or "C:" (concat (pop components) sep-string (pop components)) (pop components))) (len (+ (length prefix) 7)) ; "/ ... /" postfix) (when (cdr components) ; more than one remaining dir component (setq components (nreverse components)) (incf len (length (car components))) (push (pop components) postfix) ; always use last one (while (<= (incf len (1+ (length (car components)))) max-string) (push (pop components) postfix)) (concat prefix sep-string " ... " sep-string (mapconcat 'identity postfix sep-string))))))) (defun session-menu-maybe-accelerator (menu-items menu) "Return menu consisting of items in MENU-ITEMS and MENU. MENU-ITEMS have the usual format of elements in a menu, except that the name always starts with a accelerator specification \"%_. \". Also, a :keys specification will be evaluated if :keys is the first keyword. The items in MENU will be modified to add accelerator specifications if `session-menu-accelerator-support' is non-nil." (append menu-items (if session-menu-accelerator-support (funcall session-menu-accelerator-support menu) menu))) (defun session-change-menu-item (item) ;; TODO: delete "Change ITEM according to `session-menu-maybe-accelerator'." (if (vectorp item) (let ((keys (and (eq (aref item 2) :keys) (not (stringp (aref item 3)))))) (if (if session-menu-accelerator-support keys t) (prog1 (setq item (copy-sequence item)) (if keys (aset item 3 (eval (aref item 3)))) (or session-menu-accelerator-support (aset item 0 (substring (aref item 0) 4)))) item)) item)) (defun session-abbrev-file-name (name) "Return a version of NAME shortened using `directory-abbrev-alist'. This function does not consider remote file names (see `session-abbrev-inhibit-function') and substitutes \"~\" for the user's home directory." (if (and session-abbrev-inhibit-function (or (not (fboundp session-abbrev-inhibit-function)) (funcall session-abbrev-inhibit-function name))) name (cond-emacs-xemacs (abbreviate-file-name name :XEMACS t)))) ;;;=========================================================================== ;;; Functions in hooks ;;;=========================================================================== (defun session-find-file (filename) ;; also sets history when just switching to existing buffer (interactive "FFind file: ") (find-file filename) (let ((session-use-package t)) ;#dynamic (session-set-file-name-history))) (defun session-set-file-name-history () "Add file-name of current buffer to `file-name-history'. Don't add the file name if it matches `session-set-file-name-exclude-regexp', or if it is already at the front of `file-name-history'. This function is useful in `find-file-hooks'." (and session-use-package buffer-file-name (not (string= (car file-name-history) buffer-file-name)) (not (string= (car file-name-history) buffer-file-truename)) ;; (file-exists-p buffer-file-name) (file-readable-p buffer-file-name) (let ((name (session-abbrev-file-name buffer-file-name))) (unless (and session-set-file-name-exclude-regexp (string-match session-set-file-name-exclude-regexp name)) (push name file-name-history))))) (defun session-find-file-hook () "Function in `find-file-hooks'. See `session-file-alist'." (unless (or (eq this-command 'session-disable) (null session-use-package)) (let* ((ass (assoc (session-buffer-file-name) session-file-alist)) (point (second ass)) (mark (third ass)) (min (fourth ass)) (max (fifth ass)) (alist (nthcdr 7 ass))) (condition-case nil (while alist (if (local-variable-if-set-p (caar alist) (current-buffer)) (set (caar alist) (cdar alist))) (setq alist (cdr alist))) (error nil)) (setq session-last-change (seventh ass)) (and mark (<= (point-min) mark) (<= mark (point-max)) ;; I had `set-mark' but this function activates mark in Emacs, but ;; not in XEmacs. `push-mark' is also OK and doesn't activate in ;; both Emacsen which is better if we use `pending-delete-mode'. (push-mark mark t)) (and min max (<= (point-min) min) (<= max (point-max)) (narrow-to-region min max)) (and point (<= (point-min) point) (<= point (point-max)) (goto-char point))))) (defun session-kill-buffer-hook () "Function in `kill-buffer-hook'. See `session-file-alist' and `session-registers'." (if (and session-use-package buffer-file-name) (let ((arg (if (memq this-command session-kill-buffer-commands) (prefix-numeric-value current-prefix-arg) 1))) (condition-case nil (if (> arg -2) (session-store-buffer-places arg) (setq file-name-history (delete buffer-file-truename (delete buffer-file-name file-name-history))) ;;; (setq session-file-alist ;;; (delete* (session-buffer-file-name) session-file-alist ;;; :key 'car :test 'string=))) ; Emacs CL policy... (let ((fname (session-buffer-file-name)) (alist (cons nil session-file-alist))) (while (cdr alist) (if (string= (cadr alist) fname) (setcdr alist (cddr alist)) (setq alist (cdr alist)))) (setq session-file-alist (cdr alist)))) (error nil))))) ;;;=========================================================================== ;;; Change register contents from marker to file ;;;=========================================================================== (defun session-register-swap-out () "Turn markers in registers into file references when a buffer is killed. See variable `session-register-swap-out'." (and buffer-file-name (let ((tail register-alist)) (while tail (and (markerp (cdr (car tail))) (eq (marker-buffer (cdr (car tail))) (current-buffer)) (setcdr (car tail) (cons 'file buffer-file-name))) (setq tail (cdr tail)))))) ;;;;########################################################################## ;;;; Save global variables, add functions to hooks ;;;;########################################################################## (defvar session-successful-p nil "Whether the file `session-save-file' has been loaded successfully.") ;;;=========================================================================== ;;; The buffer file name ;;;=========================================================================== (defun session-xemacs-buffer-local-mswindows-file-p () "Return t if the current buffer visits a local file on MS-Windows. Also returns t if the current buffer does not visit a file. Return nil of the current buffer visits a file starting with \"\\\\\". Workaround for XEmacs bug in `file-truename' for file names starting with \"\\\\\"." (or (< (length buffer-file-name) 2) (not (string= (substring buffer-file-name 0 2) "\\\\")))) (defun session-buffer-file-name () "Return the buffer file name according to `session-use-truenames'." (if (if (functionp session-use-truenames) (funcall session-use-truenames) session-use-truenames) buffer-file-truename buffer-file-name)) ;;;=========================================================================== ;;; Store places and local variables for buffer to be killed ;;;=========================================================================== (defun session-toggle-permanent-flag (arg &optional check) "Toggle the permanent flag of the current buffer. With ARG, set permanent flag if and only if ARG is positive. If the permanent flag is set, the places are stored as well. If CHECK is non-nil, just return the status of the permanent flag: either nil if it is unset or `session-menu-permanent-string' if it is set." (interactive "P") (if buffer-file-name (let ((permanent (if arg (> (prefix-numeric-value arg) 0) (not (nth 5 (assoc (session-buffer-file-name) session-file-alist)))))) (if check (if permanent nil session-menu-permanent-string) (session-store-buffer-places (if permanent 3 -1)) (message (if permanent "Permanent flag is set and places are stored" "Permanent flag has been unset")))) (if check nil (error "Buffer is not visiting a file")))) (defun session-store-buffer-places (arg) "Store places and local variables in current buffer. An entry for the current buffer and its places is added to the front of `session-file-alist' if the buffer is visiting a file and if it is mentioned in the list below. ARG is the prefix argument to a command in `session-kill-buffer-commands' or 1 for any other command. ARG=-1: delete PERMANENT flag for buffer, ARG=0: do nothing, ARG=1: store buffer places, if the PERMANENT flag is set or the buffer passes the function in `session-buffer-check-function', ARG=2: always store buffer places, ARG=3: set PERMANENT flag and store buffer places. See also `session-last-change' and `session-locals-include'. Note that not storing buffer places does not mean deleting an old entry for the same file. It means that there is the danger of the entry becoming too old to be saved across session. By default, only the first 100 entries of `session-file-alist' are saved, see `session-globals-include'." (let ((file-name (session-buffer-file-name))) (when file-name (let ((permanent (nthcdr 5 (assoc file-name session-file-alist)))) (and (< arg 0) (car permanent) (setcar permanent nil)) ; reset permanent in existing entry (setq permanent (or (car permanent) (> arg 2))) (if (or (and permanent (> arg 0)) (> arg 1) (and (= arg 1) (funcall session-buffer-check-function (current-buffer)))) (let ((locals session-locals-include) (store nil)) (while locals (if (if (functionp session-locals-include) (funcall session-locals-predicate (car locals) (current-buffer)) session-locals-predicate) (push (cons (car locals) (symbol-value (car locals))) store)) (setq locals (cdr locals))) (setq store (nconc (list file-name (point) (mark t) (point-min) (and (<= (point-max) (buffer-size)) (point-max)) permanent (session-undo-position 0 nil nil)) store)) (if (equal (caar session-file-alist) file-name) (setcar session-file-alist store) (push store session-file-alist)))))))) (defun session-find-file-not-found-hook () "Query the user to delete the permanent flag for a non-existent file. Always return nil." (when session-use-package (let ((file-name (session-buffer-file-name))) (when file-name (let ((permanent (nthcdr 5 (assoc file-name session-file-alist)))) (and (car permanent) (y-or-n-p "Delete permanent flag for non-existent file? ") (setcar permanent nil))))))) ;;;=========================================================================== ;;; Default standard check for buffers to be killed ;;;=========================================================================== (defun session-default-buffer-check-p (buffer) "Default function for `session-buffer-check-function'. Argument BUFFER should be the current buffer." (and ;; undo check ------------------------------------------------------------- (or (and (eq (cdr-safe session-undo-check) 'or) session-last-change) (and (or (not (eq (cdr-safe session-undo-check) 'and)) session-last-change) (>= (if (listp buffer-undo-list) (length buffer-undo-list) -1) (if (consp session-undo-check) (car session-undo-check) session-undo-check)))) ;; mode and name check ---------------------------------------------------- (let ((file (buffer-file-name buffer))) (and (or (and (fboundp session-abbrev-inhibit-function) (funcall session-abbrev-inhibit-function file)) (and (file-exists-p file) (file-readable-p file))) (if (if session-auto-store (not (memq major-mode session-mode-disable-list)) (memq major-mode session-mode-enable-list)) (not (and session-name-disable-regexp (string-match session-name-disable-regexp file))) (and session-name-enable-regexp (string-match session-name-enable-regexp file))))))) ;;;=========================================================================== ;;; Save session file ;;;=========================================================================== (defun session-save-session (&optional force) "Save session: file places, *-ring, *-history, registers. Save some global variables and registers into file `session-save-file' with coding system `session-save-file-coding-system'. Run functions in `session-before-save-hook' before writing the file. See also `session-globals-regexp', `session-globals-include' and `session-registers'. This command is executed when using \\[save-buffers-kill-emacs] without prefix argument 0. See `kill-emacs-hook'." (interactive "p") (and (or force session-use-package) session-save-file (not (and (eq this-command 'save-buffers-kill-emacs) (equal current-prefix-arg 0))) (or session-successful-p (not (file-exists-p session-save-file)) (y-or-n-p "Overwrite old session file (not loaded)? ")) (save-excursion ;; `kill-emacs' doesn't kill the buffers ---------------------------- (dolist (buffer (nreverse (buffer-list))) (set-buffer buffer) (when buffer-file-name (condition-case nil ; potential errors with remote files (session-store-buffer-places 1) (error nil)) (if session-register-swap-out (funcall session-register-swap-out)))) ;; create header of session file ------------------------------------ (set-buffer (get-buffer-create " session ")) (erase-buffer) (let ((coding-system-for-write ;#dynamic (and session-save-file-coding-system (condition-case nil (check-coding-system session-save-file-coding-system) (error nil))))) (when coding-system-for-write (insert (format ";;; -*- coding: %S; -*-\n" session-save-file-coding-system))) (insert ";;; Automatically generated on " (current-time-string) "\n;;; Invoked by " (user-login-name) "@" (system-name) " using " emacs-version "\n") ;; save global variables and registers ---------------------------- (let ((s-excl session-globals-exclude)) (dolist (incl (append session-globals-include (apropos-internal session-globals-regexp 'boundp))) (let ((symbol (if (consp incl) (car incl) incl))) (unless (memq symbol s-excl) (push symbol s-excl) (when (default-boundp symbol) (session-save-insert-variable symbol (default-value symbol) (cdr-safe incl))))))) (session-save-registers) ;; write session file --------------------------------------------- (run-hooks 'session-before-save-hook) (condition-case var (progn (if (file-exists-p session-save-file) (delete-file session-save-file)) (make-directory (file-name-directory session-save-file) t) (write-region (point-min) (point-max) session-save-file) (if session-save-file-modes (set-file-modes session-save-file session-save-file-modes))) (error ; efs would signal `ftp-error' (or (y-or-n-p "Could not write session file. Exit anyway? ") (cond-emacs-xemacs (:EMACS signal :XEMACS signal-error :BOTH (car var) (cdr var)))))) (kill-buffer (current-buffer)))))) (defun session-save-insert-variable (symbol val spec) ;; we don't print at all: ;; - level-1 recursive lists ;; - non true-list-p lists ;; we don't print the following elements: ;; - non-cons for assoc lists ;; - string which are too long ;; - non-readable elements (includes level-n recursions) (when (consp val) (let ((print-circle (car session-save-print-spec)) ;#dynamic (print-level (cadr session-save-print-spec)) ;#dynamic (print-length (caddr session-save-print-spec)) ;#dynamic (len (or (car spec) session-globals-max-size)) (ass-p (cadr spec)) (slist nil) klist clist) (while (and (consp val) (> len 0)) (if (memq val clist) (setq val t) ; don't print recursive lists (push val clist) (let* ((elem (pop val)) (estr (prin1-to-string elem))) ;; read/load isn't clever: ignore non-readable elements (unless (cond (ass-p (or (atom elem) (member (car elem) klist) (condition-case nil (prog1 nil (read estr) (push (car elem) klist)) (error t)))) ((member estr slist)) ((stringp elem) (> (length elem) session-globals-max-string)) ((condition-case nil (prog1 nil (read estr)) (error t)))) (push estr slist) (decf len))))) (when (and slist (null val)) ; don't print non-true lists (insert (format "(setq-default %S '(" symbol)) (setq slist (nreverse slist)) (while slist (insert (pop slist) (if slist " " "))\n"))))))) (defunx session-next-range-char (char) ;; XEmacs register functions should handle integers as chars better... :emacs-only 1+ (int-to-char (1+ char))) (defun session-save-registers () "Save registers in `session-registers'." (let ((chars session-registers) (type 'file) register from to) (while chars (if (symbolp (car chars)) (setq type (car chars) chars (cdr chars)) (setq from (car chars) chars (cdr chars)) (if (consp from) (setq to (cdr from) from (car from)) (setq to from)) (while (<= from to) (setq register (get-register from)) (cond ((null register)) ((and (memq type '(file t)) (consp register) (memq (car register) '(file file-query))) (insert (if (eq (car register) 'file) (format "(set-register %S '(file . %S))\n" from (cdr register)) (format "(set-register %S '(file-query %S %d))\n" from (cadr register) (caddr register))))) ((and (memq type '(region t)) (stringp register) (< (length register) session-registers-max-string)) (insert (format "(set-register %S %S)\n" from register)))) (setq from (session-next-range-char from))))))) ;;;=========================================================================== ;;; Minibuffer history completion, see XEmacs' list-mode ;;;=========================================================================== (defvar session-history-help-string '(concat (if (device-on-window-system-p) (substitute-command-keys "Click \\\\[list-mode-item-mouse-selected] on a history element to select it.\n") "") (substitute-command-keys "In this buffer, type RET to select the element near point.\n\n")) "Form the evaluate to get a help string for history elements.") (defun session-minibuffer-history-help () "List history of current minibuffer type. In Emacs, the *History* buffer talks about \"completions\" instead \"history elements\". In XEmacs before 21.4.9, selecting an entry might not work if the minibuffer is non-empty." (interactive) (let ((history (symbol-value minibuffer-history-variable))) (message nil) (if history (with-output-to-temp-buffer "*History*" (cond-emacs-xemacs (display-completion-list (sort history #'string-lessp) :XEMACS :help-string session-history-help-string :completion-string "Elements in the history are:")) (save-excursion (set-buffer standard-output) (setq completion-base-size 0))) (ding) (session-minibuffer-message " [Empty history]")))) (defunx session-minibuffer-message (string) :emacs-only minibuffer-message :xemacs-only temp-minibuffer-message) ;;;=========================================================================== ;;; Set hooks, load session file ;;;=========================================================================== ;; easymenu.el is for top-level menus only... both Emacs and XEmacs could ;; profit from a better menu interface... (defunx session-add-submenu (menu) "Add the menu MENU to the beginning of the File menu in the menubar. If the \"File\" menu does not exist, no submenu is added. See `easy-menu-define' for the format of MENU." (and menu :EMACS (>= emacs-major-version 21) (boundp 'menu-bar-files-menu) (let ((keymap (easy-menu-create-menu (car menu) (cdr menu)))) ;; `easy-menu-get-map' doesn't get the right one => use hard-coded (define-key menu-bar-files-menu (vector (intern (car menu))) (cons 'menu-item (cons (car menu) (if (not (symbolp keymap)) (list keymap) (cons (symbol-function keymap) (get keymap 'menu-prop))))))) :XEMACS (featurep 'menubar) (let ((current-menubar default-menubar) ;#dynamic (first (cadar (find-menu-item default-menubar '("File"))))) (when first ;; XEmacs-20.4 `add-submenu' does not have 4th arg IN-MENU (add-submenu '("File") menu ;; arg BEFORE cannot be retrieved by any ;; menubar function -- great... (cond ((vectorp first) (aref first 0)) ((consp first) (car first)))))))) (defunx session-initialize-keys () (define-key ctl-x-map [(undo)] 'session-jump-to-last-change) (define-key ctl-x-map [(control ?\/)] 'session-jump-to-last-change) (define-key minibuffer-local-map [(meta ?\?)] 'session-minibuffer-history-help) :XEMACS ;; C-down-mouse-3 pops up mode menu under Emacs (define-key global-map [(control button3)] 'session-popup-yank-menu) :EMACS ;; Emacs doesn't seem to have keymap inheritance... (define-key minibuffer-local-completion-map [(meta ?\?)] 'session-minibuffer-history-help) (define-key minibuffer-local-must-match-map [(meta ?\?)] 'session-minibuffer-history-help) (define-key minibuffer-local-ns-map [(meta ?\?)] 'session-minibuffer-history-help)) (defunx session-initialize-menus () (session-add-submenu '("Open...Recently Visited" :included file-name-history :filter session-file-opened-menu-filter ["Move File Names Of All Buffers To Top" session-file-opened-recompute] "---")) (session-add-submenu '("Open...Recently Changed" ;;:included session-file-alist :filter session-file-changed-menu-filter ["Perform Evaluation For All Buffers" session-file-changed-recompute] ["Permanently List Current Buffer " session-toggle-permanent-flag ;; :keys must be at third position! ;;:keys (session-toggle-permanent-flag nil t) :active buffer-file-name :style toggle :selected (session-toggle-permanent-flag nil t)] "---")) :XEMACS (and (featurep 'menubar) (find-menu-item default-menubar '("Edit")) (let ((current-menubar default-menubar)) ;; XEmacs-20.4 `add-submenu' does not have 4th arg IN-MENU (add-submenu '("Edit") '("Select and Paste" :included kill-ring :filter session-yank-menu-filter) (cond ((find-menu-item default-menubar '("Edit" "Delete")) "Delete") ; why just BEFORE, not AFTER ((find-menu-item default-menubar '("Edit" "Paste")) "Paste") ((find-menu-item default-menubar '("Edit" "Undo")) "Undo")))))) (defun session-initialize-do () "Initialize package session and read previous session file. Setup hooks and load `session-save-file', see variable `session-initialize'. At best, this function is called at the end of the Emacs startup, i.e., add this function to `after-init-hook'." (when (and session-use-package (null (get 'session-initialize :initilized-with))) (when (or (eq session-initialize t) (memq 'de-saveplace session-initialize)) ;; Features of package saveplace, which has an auto-init, are covered by ;; this package. (when (functionp 'eval-after-load) (eval-after-load "saveplace" '(progn (remove-hook 'find-file-hooks 'save-place-find-file-hook) (remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook) (remove-hook 'kill-buffer-hook 'save-place-to-alist))))) (when (or (eq session-initialize t) (memq 'places session-initialize)) ;; `session-find-file-hook' should be *very* late in `find-file-hooks', ;; esp. if some package, e.g. crypt, iso-cvt, change the buffer contents: (add-hook 'find-file-hooks 'session-find-file-hook t) (add-hook 'find-file-not-found-hooks 'session-find-file-not-found-hook t) (add-hook 'kill-buffer-hook 'session-kill-buffer-hook) (if session-register-swap-out (add-hook 'kill-buffer-hook session-register-swap-out))) (when (or (eq session-initialize t) (memq 'keys session-initialize)) (condition-case nil (session-initialize-keys) (error nil))) (when (or (eq session-initialize t) (memq 'menus session-initialize)) (unless (memq 'session-set-file-name-history find-file-hooks) ;; already initialized (probably not a good idea to redo for menus) (add-hook 'find-file-hooks 'session-set-file-name-history) (session-initialize-menus))) (when (or (eq session-initialize t) (memq 'session session-initialize)) (add-hook 'kill-emacs-hook 'session-save-session) (or session-successful-p (setq session-successful-p (and session-save-file (condition-case nil (progn ;; load might fail with coding-system = emacs-mule (unless (load session-save-file t nil t) (and session-old-save-file (load session-old-save-file t nil t))) (run-hooks 'session-after-load-save-file-hook) t) (error nil)))))) (put 'session-initialize :initilized-with session-initialize))) (defun session-initialize-and-set (symbol value) (set-default symbol value) ; symbol should be `session-use-package' (when value (if (cond-emacs-xemacs :EMACS (and (boundp 'after-init-time) (null after-init-time)) :XEMACS (null init-file-loaded)) ;; in the meantime,`session-use-package' could have been reset to nil ;; (e.g. when using custom theme with t, user setting with nil) (add-hook 'after-init-hook 'session-initialize-do) (session-initialize-do)))) ;; This must be late in this file as set function is called during loading. (defcustom session-use-package nil "Pseudo variable. Used to initialize session in custom buffer. Put `(session-initialize)' into your ~/.emacs to initialize package session in future sessions. See variable `session-initialize'." :group 'session :type '(boolean :on "in use" :off "not yet initialized or turned off" :help-echo "Use package Session, initialize if necessary.") :require 'session :set 'session-initialize-and-set) ;;;###autoload (defun session-initialize () "Initialize package session and read previous session file. Setup hooks and load `session-save-file', see variable `session-initialize'. At best, this function is called at the end of the Emacs startup, i.e., add this function to `after-init-hook'." (interactive) (put 'session-initialize :initilized-with nil) (custom-set-variables '(session-use-package t nil (session)))) ;;; Local IspellPersDict: .ispell_session ;;; session.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/floatbg.el0000775000000000000000000001274612230377265021220 0ustar ;;; floatbg.el --- slowly modify background color ;; Copyright (C) 2001 John Paul Wallington ;; Author: John Paul Wallington ;; Created: 07 Nov 2001 ;; Version: 0.5, 11 Nov 2001 ;; Keywords: background frames faces ;; This file isn't part of Emacs. ;; 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 2, 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. ;;; Commentary: ;; Modifies backgound color by moving through an hsv color model, like ;; floatbg for X-Windows by Jan Rekers. ;; Installation: ;; Put floatbg.el somewhere in your load-path. ;; Put the following two lines in your .emacs file: ;; (require 'floatbg) ;; (floatbg-mode t) ;;; Code: (defgroup floatbg nil "Slowly modify background color by moving through an HSV color model." :tag "Floating Background" :group 'frames :prefix "floatbg-") (defcustom floatbg-mode nil "Toggle `floatbg-mode' on/off." :type 'boolean :tag "Toggle floatbg-mode on/off." :initialize 'custom-initialize-default :set (lambda (symbol value) (floatbg-mode value)) :require 'floatbg :group 'floatbg) (defcustom floatbg-delay 15 "* Delay in seconds before changing color." :type 'number :group 'floatbg) (defcustom floatbg-increment 1 "* Size of increment of Hue in degrees when changing color." :type 'number :group 'floatbg) (defcustom floatbg-initial-hue t "* Initial value of Hue (in HSV model) in degrees." :type '(choice integer (const :tag "Derived from time of day" t) (const :tag "Random" nil)) :group 'floatbg) (defun floatbg-set-val (symbol value) (if (and (numberp value) (< 0.0 value) (< value 1.0)) (set-default symbol value) (error "please set %s to more than 0.0 and less than 1.0" (symbol-name symbol)))) (defcustom floatbg-initial-val 0.88 "* Initial value of Value (in HSV model); should be > 0.0 and < 1.0." :type '(number :tag "Number more than 0.0 and less than 1.0") :set 'floatbg-set-val :group 'floatbg) (defvar floatbg-smid 0.375) (defvar floatbg-svar 0.125) (defvar floatbg-sfinhf 0.25) (defun floatbg-set-sinus-shape (symbol value) (let ((smid (car value)) (svar (car (cdr value))) (sfinhf (car (nthcdr 2 value)))) (unless (null value) (if (and (>= 1 (- smid svar)) (>= 1 (+ smid svar)) (<= 0 (- smid svar)) (<= 0 (+ smid svar))) (setq floatbg-smid smid floatbg-svar svar floatbg-sfinhf sfinhf) (error "Invalid parameters."))))) (defcustom floatbg-sinus-shape nil "* The sinus shape. Unquoted list containing smid, svar and sfinhf parameters. The default is (0.375 0.125 0.25). smid + svar and smid - svar should fall between 0 and 1." :type '(choice (const :tag "Default" nil) (sexp :tag "Specify List")) :set 'floatbg-set-sinus-shape :group 'floatbg) (defcustom floatbg-reset-on-toggle nil "* Reset colors to initial values when toggling `floatbg-mode'?" :type '(choice (const :tag "Yes" t) (const :tag "No" nil)) :group 'floatbg) (defvar floatbg-timer nil "Timer handle for floatbg mode.") (defun floatbg-initial-hue () (if (equal floatbg-initial-hue t) (* (1+ (car (nthcdr 2 (decode-time)))) 15) (or floatbg-initial-hue (random 360)))) (defvar floatbg-hue (floatbg-initial-hue)) (defvar floatbg-sat) (defvar floatbg-val floatbg-initial-val) ;;;###autoload (defun floatbg-mode (&optional arg) "Toggle floatbg mode" (interactive "P") (if floatbg-timer (cancel-timer floatbg-timer)) (when (setq floatbg-mode (if (null arg) (not floatbg-mode) (> (prefix-numeric-value arg) 0))) (if floatbg-reset-on-toggle (floatbg-reset-initial-values)) (setq floatbg-timer (run-at-time 1 floatbg-delay 'floatbg-change))) (message "floatbg-mode now %s" (if floatbg-mode "on" "off"))) (defun floatbg-change () "Change background color, imperceptibly." (setq floatbg-hue (mod (+ floatbg-hue floatbg-increment) 360) floatbg-sat (- floatbg-smid (* floatbg-svar (sin (* (/ pi 180) floatbg-sfinhf floatbg-hue))))) (let ((background (floatbg-hsv-to-rgb-string floatbg-hue floatbg-sat floatbg-val)) (frames (frame-list))) (while frames (modify-frame-parameters (car frames) (list (cons 'background-color background))) (setq frames (cdr frames))) (set-face-background 'default background))) (defun floatbg-hsv-to-rgb-string (h s v) "Convert color in HSV values to RGB string." (setq h (degrees-to-radians h)) (let (r g b) (if (zerop s) (setq r v g v b v) (let* ((h (/ (if (>= h (* 2 pi)) 0.0 h) (/ pi 3))) (i (truncate h)) (f (- h i))) (let ((p (* v (- 1.0 s))) (q (* v (- 1.0 (* s f)))) (z (* v (- 1.0 (* s (- 1.0 f)))))) (cond ((eq i 0) (setq r v g z b p)) ((eq i 1) (setq r q g v b p)) ((eq i 2) (setq r p g v b z)) ((eq i 3) (setq r p g q b v)) ((eq i 4) (setq r z g p b v)) ((eq i 5) (setq r v g p b q)))))) (format "#%.2X%.2X%.2X" (* r 255) (* g 255) (* b 255)))) (defun floatbg-reset-initial-values () "Reset floatbg colors to initial values." (interactive) (setq floatbg-hue (floatbg-initial-hue) floatbg-val floatbg-initial-val)) (provide 'floatbg) ;;; floatbg.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/dict.el0000775000000000000000000005343412230377266020525 0ustar ;; dict.el --- Emacs interface to dict client ;; ;; $Id: dict.el,v 1.6 2009-09-04 01:50:58 psg Exp $ ;; ;; Copyright (c) 2002, 2003, 2004 Max Vasin ;; ;; 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 2 ;; 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, write to the Free Software Foundation, Inc., ;; 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. ;;; Commentary ;; ;; dict.el is an Emacs wrapper around `dict' command to provide an easy and ;; comfortable (from my point of view) access to the dictd server from the Emacs. ;; The package was written and tested under GNU Emacs 21 only but I hope it should ;; work under other Emacs versions as well. dict.el depends on bash or compatible shell ;; (I haven't tested it with other shells), cut, sed, awk, and dict. A coding convertion ;; program can be used to use automatic recoding thus allowing databases in different ;; codings. ;; ;; The package provides several key bindings, which are customisation variables, ;; so you can change them easily without recompiling the package: ;; 1. `C-c d d' for running dict with options defined by customisation ;; variables described below. ;; 2. `C-c d r' for running dict on region as a single word. ;; 3. `C-c d m' for running dict on every word in the region. ;; 4. `C-c d s' for running dict to perform search on the given server. ;; 5. `C-c d S' to view similar words for the last dict run. ;; ;; Descriptions of all customisation variables are given below in their ;; definitions, and of cause you can find them in the customisation buffer ;; (External->Dict). ;; ;; I hope you find the program usefull. And also I would like to know your ;; opinion about the program, improvement suggestions and of cause bug reports. ;; Mail them to ;;; Code: (require 'cl) (defgroup Dict nil "Browse DICT dictionaries." :prefix "dict-" :group 'external) ;;;; ;;;; Definitions of dict client parameter variables ;;;; (defcustom dict-servers '("dict.org" "alt0.dict.org" "alt1.dict.org" "alt2.dict.org") "Specifies the hostname for the DICT server. If IP lookup for a server expands to a list of IP addresses (as dict.org does currently), then each IP will be tried in the order listed." :type '(repeat (string :tag "Server name")) :group 'Dict) ;; Forward declarations (defcustom dict-databases nil "Foo." :type 'string :group 'Dict) (defcustom dict-strategies nil "Bar." :type 'string :group 'Dict) (defcustom dict-service "" "Specifies the port or service for connections. The default is 2628, as specified in the DICT Protocol RFC." :type 'string :group 'Dict) (defcustom dict-match nil "Instead of printing a definition, perform a match using the specified strategy." :type 'boolean :group 'Dict) (defcustom dict-nocorrect nil "Disable spelling correction. Usually, if a definition is requested and the word cannot be found, spelling correction is requested from the server, and a list of possible words are provided. This option disables the generation of this list." :type 'boolean :group 'Dict) (defcustom dict-noauth nil "Disable authentication (i.e., don't send an AUTH command)." :type 'boolean :group 'Dict) (defcustom dict-user "" "Specifies the username for authentication." :type 'string :group 'Dict) (defcustom dict-key "" "Specifies the shared secret for authentication." :type 'string :group 'Dict) (defcustom dict-pipesize 256 "Specify the buffer size for pipelineing commands. The default is 256, which should be sufficient for general tasks and be below the MTU for most transport media. Larger values may provide faster or slower throughput, depending on MTU. If the buffer is too small, requests will be serialised. Values less than 0 and greater than one million are silently changed to something more reasonable." :type 'integer :group 'Dict) (defcustom dict-original-server "" "Specifies original server name for the `dict-on-server' function." :type 'string :group 'Dict) (defcustom dict-client "" "Specifies additional text to be sent using the CLIENT command." :type 'string :group 'Dict) (defcustom dict-always-quote-terms nil "If t dict.el will always quote terms." :type 'boolean :group 'Dict) (defcustom dict-show-one-window nil "If t dict.el will show one window (i.e. without splitting)." :type 'boolean :group 'Dict) (defcustom dict-character-recoding-map nil "Specifies recoding command for given dictionary." :tag "DICT Character Recoding Map" :type '(repeat (list :tag "Dict servers" (string :tag "Server name") (repeat :tag "Database recoding mappings" (list :tag "Database" (regexp :tag "Database name") (string :tag "Recoding command"))))) :group 'Dict) ;;;; ;;;; Key binding customisation variables and helper functions ;;;; (defun dict-set-key-binding (key value) "Stub for setting KEY binding to VALUE." (set-default key value)) (defun dict-set-enable-key-bindings (key value) "Stub for setting KEY binding to VALUE." (set-default key value)) (defun dict-mode-set-key-binding (key value) "Stub for setting KEY binding to VALUE." (set-default key value)) (defcustom dict-enable-key-bindings nil "Enables key bindings for dict.el commands." :type 'boolean :group 'Dict :set 'dict-set-enable-key-bindings :require 'dict) (defcustom dict-key-binding "\\C-cdd" "Specifies a key binding to run dict and display the results in the Emacs buffer." :type 'string :group 'Dict :set 'dict-set-key-binding :require 'dict) (defcustom dict-region-key-binding "\\C-cdr" "Specifies a key binding to run dict on the region and display the results in the Emacs buffer." :type 'string :group 'Dict :set 'dict-set-key-binding :require 'dict) (defcustom dict-multiple-key-binding "\\C-cdm" "Run dict on region. Specifies a key binding to run dict on every word from the region and display the results in the Emacs buffer." :type 'string :group 'Dict :set 'dict-set-key-binding :require 'dict) (defcustom dict-on-server-key-binding "\\C-cds" "Run dict on server. Specifies a key binding to run dict to search word on the given server and display the results in the Emacs buffer." :type 'string :group 'Dict :set 'dict-set-key-binding :require 'dict) (defcustom dict-similar-words-key-binding "\\C-cdS" "Specifies a key binding to show similar words." :tag "Show similar words" :type 'string :group 'Dict-Mode :set 'dict-set-key-binding :require 'dict) (defgroup Dict-Mode nil "DICT-mode key bindings" :tag "DICT-mode" :prefix "dict-mode-" :group 'Dict) (defcustom dict-mode-key-binding "d" "Specifies a key binding to run dict and display the results in the Emacs buffer." :tag "DICT" :type 'string :group 'Dict-Mode :set 'dict-mode-set-key-binding :require 'dict) (defcustom dict-mode-region-key-binding "r" "Specifies a key binding to run dict on the region and display the results in the Emacs buffer." :tag "DICT region" :type 'string :group 'Dict-Mode :set 'dict-mode-set-key-binding :require 'dict) (defcustom dict-mode-multiple-key-binding "m" "Run dict on every word in region. Specifies a key binding to run dict on every word from the region and display the results in the Emacs buffer." :tag "DICT multiple" :type 'string :group 'Dict-Mode :set 'dict-mode-set-key-binding :require 'dict) (defcustom dict-mode-on-server-key-binding "s" "Specifies a key binding to run dict to search word on the given server and display the results in the Emacs buffer." :tag "DICT on server" :type 'string :group 'Dict-Mode :set 'dict-mode-set-key-binding :require 'dict) (defcustom dict-mode-similar-words-key-binding "S" "Specifies a key binding to show similar words." :tag "Show similar words" :type 'string :group 'Dict-Mode :set 'dict-mode-set-key-binding :require 'dict) (defcustom dict-buffer-coding-system nil "Specifies coding system to use in dict buffer." :tag "Input coding system for DICT buffer" :type 'string :group 'Dict-Mode) (defvar dict-similar-buffer nil) ;;;; ;;;; Service functions ;;;; (defun dict-get-databases (host) "Get a list of available databases." (let* ((dbinfo-string (shell-command-to-string (format "dict -h %s -D 2> /dev/null | awk 'BEGIN { print \"(\"; } \ /^[ ]+/ { match($0, /^[ ]+([a-z0-9]+)[ ]+(.+)/, r); print \"(\\\"\" r[1] \"\\\"\" \" \\\"\" r[2]\"\\\")\"; } \ END { print \")\" }'" host))) (dbinfo (read dbinfo-string)) (dbnames (mapcar 'car dbinfo)) (dbdecss (mapcar 'cadr dbinfo))) `(,dbnames ,dbdecss))) (defun dict-get-strategies (host) "Get a list of strategies." (let* ((stratsinfo-string (shell-command-to-string (format "dict -h %s -S 2> /dev/null | awk 'BEGIN { print \"(\"; } \ /^[ ]+/ { match($0, /^[ ]+([a-z0-9]+)[ ]+(.+)/, r); print \"(\\\"\" r[1] \"\\\"\" \" \\\"\" r[2]\"\\\")\"; } \ END { print \")\" }'" host))) (stratsinfo (read stratsinfo-string)) (stnames (mapcar 'car stratsinfo)) (stdecss (mapcar 'cadr stratsinfo))) `(,stnames ,stdecss))) (defun dict-generate-constant (value tag) "Generate constant for customisation type of VALUE with TAG." `(const :tag ,tag ,value)) (defun dict-get-database-names (host) "Get a list of available database names." (mapcar 'symbol-name (read (concat "(" (shell-command-to-string (format "dict -h %s -D 2> /dev/null | cut -f 2 -d ' ' | sed -e '1 d'" host host)) ")")))) (defcustom dict-strategies (mapcar (lambda (h) (list h nil)) dict-servers) "Specify a matching strategy. By default, the server default match strategy is used. This is usually \"exact\" for definitions, and some form of spelling-correction strategy for matches (\".\" fromthe DICT protocol). The available strategies are dependent on the server implemenation." :type `(list :tag "Server" ,@(mapcar (lambda (h) `(list (const ,h) (choice :tag "Strategies" ,@(apply 'mapcar* 'dict-generate-constant (dict-get-strategies h)) (const :tag "default" nil)))) dict-servers)) :group 'Dict) (defcustom dict-databases (mapcar (lambda (h) (list h (dict-get-database-names h))) dict-servers) "Specifies a specific database to search. The default is to search all databases (a * from the DICT protocol). Note that a ! in the DICT protocol means to search all of the databases until a match is found, and then stop searching." :type `(list :tag "Server" ,@(mapcar (lambda (h) `(list (const ,h) (set :tag "Databases" ,@(apply 'mapcar* 'dict-generate-constant (dict-get-databases h))))) dict-servers)) :group 'Dict) (defun dict-generate-options-list (prefix seq) "Generate a list of options of the form `PREFIX SEQ[0] PREFIX SEQ[1] ...'." (if (null seq) "" (concat prefix (car seq) (dict-generate-options-list prefix (cdr seq))))) (defsubst dict-nes (string) "T if STRING is not empty." (not (string= string ""))) (defun dict-generate-options (database host) "Generate dict's command line options based on the parameter variables' values, DATABASE and HOST" (concat (if (dict-nes dict-service) (concat " --port " dict-service) "") (if dict-match " --match" "") (if (cadr (assoc host dict-strategies)) (concat " --strategy " (cadr (assoc host dict-strategies)) "")) (if dict-nocorrect " --nocorrect ") (if dict-noauth " --noauth" "") (if (dict-nes dict-user) (concat " --user " dict-user) "") (if (dict-nes dict-key) (concat " --key " dict-key) "") (if (not (= dict-pipesize 256)) (concat " --pipesize " (number-to-string dict-pipesize)) "") (if (dict-nes dict-client) (concat " --client " dict-client) "") (concat " --database " database) (concat " --host " host) " --pager -" ; force dict to not use pager " ")) (defun dict-newline-to-space (string) "Replace newline with space in STRING." (let ((result (make-string (length string) ?x))) (dotimes (i (length string) 1) (aset result i (if (char-equal (aref string i) ?\n) ?\ (aref string i)))) result)) (defun dict-reduce-spaces (string) "Replace multiple sequencial whitespaces in STRING with one whitespace." (if (not (string-match "[ \t][ \t]+" string)) string (dict-reduce-spaces (replace-match " " t "\\&" string nil)))) (defsubst dict-normalise-request (request) "Replace newlines and multiple spaces with one space in the REQUEST." (dict-reduce-spaces (dict-newline-to-space request))) (defun dict-quote (word) "Quote WORD if necessary." (if dict-always-quote-terms (if (or (and (eq (aref word 0) ?\") (eq (aref word (- (length word) 1)) ?\")) (and (eq (aref word 0) ?\') (eq (aref word (- (length word) 1)) ?\'))) word (concat "'" word "'")) word)) (defun dict-generate-command (word database host) "Generate dict command to search in the given DATABASE and HOST." (let ((recoding-command (or (cadr (assoc database (cadr (assoc host dict-character-recoding-map)))) (cadr (assoc "*" (cadr (assoc host dict-character-recoding-map))))))) (if recoding-command (format "dict %s %s | %s" (dict-generate-options database host) (dict-quote word) recoding-command) (format "dict %s %s" (dict-generate-options database host) (dict-quote word))))) (defun dict-get-answer (what) "Recieve the answer for WHAT from the dict and insert in ther buffer." (let* ((word (dict-normalise-request what)) (buffer-name (concat "*DICT " word "*")) (similar-buffer-name (concat "*DICT " word " (similar) *")) (buffer (or (get-buffer buffer-name) (generate-new-buffer buffer-name))) (similar-buffer (or (get-buffer similar-buffer-name) (generate-new-buffer similar-buffer-name))) (coding-system-for-read dict-buffer-coding-system) (coding-system-for-write dict-buffer-coding-system)) (setq dict-similar-buffer similar-buffer) (save-current-buffer (set-buffer similar-buffer) (kill-region (point-min) (point-max)) (set-buffer buffer) (kill-region (point-min) (point-max)) (make-local-variable 'dict-similar-buffer) (setq dict-similar-buffer similar-buffer) (dict-mode)) (message "Invoking dict %s in the background" word) (mapcar (lambda (host) (mapcar (lambda (database) (set-process-sentinel (start-process "dict" (generate-new-buffer "dict") "sh" "-c" (dict-generate-command word database host)) (dict-make-sentinel-with-buffer buffer))) (if (cadr (assoc host dict-databases)) (cadr (assoc host dict-databases)) (dict-get-database-names host)))) dict-servers))) (defun dict-add-result-to-buffer (result-buffer output-buffer) "Add dict's answer from RESULT-BUFFER to OUTPUT-BUFFER." ;; Preformat data in the result buffer (set-buffer result-buffer) (goto-char (point-min)) (kill-line 2) ;; Insert answer into the output buffer (set-buffer output-buffer) (goto-char (point-max)) (insert-buffer-substring result-buffer) (kill-buffer result-buffer) (goto-char (point-min)) (display-buffer output-buffer) (when dict-show-one-window (switch-to-buffer output-buffer) (delete-other-windows))) (defun dict-get-error-message (string) "Returns error message, cutting ', perhaps you mean:' from the STRING." (if (char-equal (elt string (- (length string) 1)) ?:) (substring string 0 (- (length string) (length ", perhaps you mean:"))) string)) (defun dict-make-sentinel-with-buffer (buffer) "Make process sentinel to write result to BUFFER." (lexical-let ((output-buffer buffer)) (lambda (process msg) (let ((process-buffer (process-buffer process))) (cond ((string= "finished\n" msg) (save-excursion (set-buffer process-buffer) (set-buffer-modified-p nil) (beginning-of-buffer) (if (string= (buffer-substring-no-properties (point-min) 25) "No definitions found for") ;; dict didn't find word in the given database (let ((error-message (dict-get-error-message (buffer-substring-no-properties (point-min) (- (search-forward "\n") 1))))) (let ((similar-words (buffer-substring-no-properties (point) (- (point-max) 1)))) (kill-buffer (current-buffer)) (set-buffer output-buffer) (set-buffer dict-similar-buffer) (insert similar-words) (message error-message))) ;; ok we've got an answer (dict-add-result-to-buffer process-buffer output-buffer)))) ((string-match "exited abnormally with code" msg) (message msg))))))) (defsubst dict-default-dict-entry () "Make a guess at a default dict entry. This guess is based on the text surrounding the cursor." (let (word) (save-excursion (setq word (current-word)) (if (string-match "[._]+$" word) (setq word (substring word 0 (match-beginning 0)))) word))) ;;;; ;;;; Lookup functions ;;;; (defun dict (word) "Lookup a WORD in the dictionary." (interactive (list (let* ((default-entry (dict-default-dict-entry)) (input (read-string (format "Dict entry%s: " (if (string= default-entry "") "" (format " (default %s)" default-entry)))))) (if (string= input "") (if (string= default-entry "") (error "No dict args given") default-entry) input)))) (dict-get-answer word)) (defun dict-region (from to) "Lookup a region (FROM, TO) in the dictionary." (interactive (list (region-beginning) (region-end))) (dict (concat "\"" (buffer-substring-no-properties from to) "\""))) (defun dict-multiple (from to) "Lookup every word from the region (FROM, TO) in the dictionary." (interactive (list (region-beginning) (region-end))) (dict (buffer-substring-no-properties from to))) (defun dict-on-server (word server) "Lookup a WORD in the dictionary on the given SERVER." (interactive (list (let* ((default-entry (dict-default-dict-entry)) (input (read-string (format "Dict entry%s: " (if (string= default-entry "") "" (format " (default %s)" default-entry)))))) (if (string= input "") (if (string= default-entry "") (error "No dict args given") default-entry) input)) (read-string "DICT server: " nil))) (if (not (string= server "")) (let ((dict-servers `(,server))) (dict word)) (dict word))) (defun dict-show-similar () "Show list of similar words." (interactive) (when (bufferp dict-similar-buffer) (display-buffer dict-similar-buffer))) (defun dict-set-key-binding (key value) "Set KEY binding customisation variable to VALUE." (let ((result (set-default key value))) (set-default 'dict-enable-key-bindings t) (dict-update-key-bindings) result)) (defun dict-set-enable-key-bindings (key value) "Set KEY to VALUE and update dict key bindings." (let ((result (set-default key value))) (dict-update-key-bindings) result)) (defun dict-process-key-binding (string) "Process a STRING representing a key binding to allow easy key binding customisation." (read (concat "\"" string "\""))) (defvar dict-mode-keymap (make-sparse-keymap)) (defun dict-mode-set-key-binding (key value) "Set KEY binding customisation variable to VALUE (for DICT-mode)." (let ((result (set-default key value))) (dict-mode-update-key-bindings) result)) (defun dict-mode () (interactive) (use-local-map dict-mode-keymap) (setq mode-name "DICT") (setq major-mode 'dict-mode)) (defun dict-update-key-bindings () "Update dict key bindings." (when dict-enable-key-bindings ;; Setup global key binding `C-c d d' for running dict... (global-set-key (dict-process-key-binding dict-key-binding) 'dict) ;; ... `C-c d r' for running dict on the region... (global-set-key (dict-process-key-binding dict-region-key-binding) 'dict-region) ;; ... `C-c d m' for running dict on every word in the region... (global-set-key (dict-process-key-binding dict-multiple-key-binding) 'dict-multiple) ;; ... `C-c d s' for running dict to perform search on the given server. (global-set-key (dict-process-key-binding dict-on-server-key-binding) 'dict-on-server) ;; ... `S' to show similar words. (global-set-key (dict-process-key-binding dict-similar-words-key-binding) 'dict-show-similar))) (defun dict-mode-update-key-bindings () "Update dict key bindings for DICT-mode." ;; Setup DICT-mode key binding `d' for running dict... (define-key dict-mode-keymap (dict-process-key-binding dict-mode-key-binding) 'dict) ;; ... `r' for running dict on the region... (define-key dict-mode-keymap (dict-process-key-binding dict-mode-region-key-binding) 'dict-region) ;; ... `m' for running dict on every word in the region... (define-key dict-mode-keymap (dict-process-key-binding dict-mode-multiple-key-binding) 'dict-multiple) ;; ... `s' for running dict to perform search on the given server... (define-key dict-mode-keymap (dict-process-key-binding dict-mode-on-server-key-binding) 'dict-on-server) ;; ... `S' to show similar words. (define-key dict-mode-keymap (dict-process-key-binding dict-mode-similar-words-key-binding) 'dict-show-similar)) ;;;; ;;;; Informational functions ;;;; (defun dict-version () "Display dict version information." (interactive) (shell-command "dict --version")) (defconst dict-version "$Revision: 1.6 $" "Version number for 'dict' package.") (defun dict-version-number () "Return 'dict' version number." (string-match "[0123456789.]+" dict-version) (match-string 0 dict-version)) (defun dict-display-version () "Display 'dict.el' version." (interactive) (message "dict.el version <%s>." (dict-version-number))) (dict-update-key-bindings) (dict-mode-update-key-bindings) (provide 'dict) ;;; dict.el ends here emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/twiddle.el0000775000000000000000000002477112230377265021237 0ustar ;;; twiddle.el --- mode-line display hack ;; Copyright (C) 1997 Noah S. Friedman ;; Author: Noah Friedman ;; Maintainer: friedman@prep.ai.mit.edu ;; Keywords: extensions ;; Status: Works in Emacs 19 and XEmacs. ;; Created: 1997-03-12 ;; $Id: twiddle.el,v 1.1.1.1 2003-04-04 20:16:17 lolando Exp $ ;; 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 2, 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, you can either send email to this ;; program's maintainer or write to: The Free Software Foundation, ;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. ;;; Commentary: ;; Inspired by a similar hack by Jim Blandy . ;; There are two user commands of interest: twiddle-start and twiddle-compile. ;; If you write new twiddles, try to minimize or avoid consing, since those ;; functions are called constantly. ;;; Code: (eval-and-compile (defconst twiddle-xemacs-p (save-match-data (string-match "XEmacs" (emacs-version)))) (if twiddle-xemacs-p (require 'itimer) (require 'timer)) ) ;; end eval-and-compile (defvar twiddle-properties nil "*Text properties to put on the twiddle text.") (defconst twiddle-delay 1 "*Default amount of time between mode line updates, in seconds. This can be overridden for specific hacks in `twiddle-hacks'.") (defconst twiddle-default-hack "twiddle" "*Default twiddle to run.") (defconst twiddle-hacks '(("twiddle" twiddle-frob-twiddle 0 " - ") ("roll" twiddle-frob-roll 5 ?\ ) ("asterisk" twiddle-frob-asterisk 10 ?-)) "*Twiddle hacks. This is an alist of hacks, where each member contains the following elts: 0. A name used for completion by `twiddle-start' and `twiddle-compile'. 1. A twiddle function. 2. The length of the twiddle string in the mode line. 3. The initial char in each position of the twiddle string. This may also be a string, in which case the contents of this string is used as the initial value and the length parameter is ignored. 4. (optional) A time delay between mode line updates, in seconds. If not specified, the value of `twiddle-delay' is used. 5. (optional) This and any remaining arguments are passed to the function specified in field 1 each time it's called.") ;; Internal twiddle data (defvar twiddle-mode-string nil) (defvar twiddle-timer nil) (defvar twiddle-current-pos 0) (defvar twiddle-current-saved-char nil) (defvar twiddle-direction 'identity) (defvar twiddle-temp nil) (defconst twiddle-rotate-chars '(?| ?/ ?- ?\\)) ;;;###autoload (defun twiddle-start (&optional hack) "Start a mode line display hack. If called interactively with a prefix argument, prompt for the name of a hack to run. If called from lisp, optional argument HACK is the name of a hack to run. Named hacks are defined in the table `twiddle-hacks'." (interactive (list (and current-prefix-arg (twiddle-read-hack-complete)))) (or hack (setq hack twiddle-default-hack)) (let ((hack-data (assoc hack twiddle-hacks))) (cond ((null hack-data) (if hack (error "Unknown twiddle hack: %s" hack) (error "No twiddle hack specified."))) (t (apply 'twiddle-start-twiddling (cdr hack-data)))))) ;;;###autoload (defun twiddle-compile (&rest compile-args) "Like \\[compile], but run a twiddle hack during compilation. If called with a prefix argument, prompt for a specific hack to run." (interactive) (let* ((hack (if current-prefix-arg (twiddle-read-hack-complete) twiddle-default-hack)) (hack-data (assoc hack twiddle-hacks))) (and (null hack-data) (if hack (error "Unknown twiddle hack: %s" hack) (error "No twiddle hack specified."))) (setq hack-data (copy-alist (cdr hack-data))) (twiddle-insert hack-data (car hack-data) 3) (twiddle-insert hack-data nil 3) (setcar hack-data 'twiddle-frob-compile) (if (interactive-p) (call-interactively 'compile) (apply 'compile compile-args)) ;; Start twiddle after compilation begins, to insure that ;; compilation-in-progress has been set. (apply 'twiddle-start-twiddling hack-data))) (defun twiddle-stop () "Stop twiddling." (interactive) (twiddle-timer-stop twiddle-timer) (setq twiddle-timer nil) (twiddle-unfrob-mode-line-format) (setq twiddle-mode-string nil) (twiddle-mode-line-update)) (defun twiddle-start-twiddling (fn len char &optional delay &rest fn-args) (twiddle-stop) (twiddle-initialize-data len char) (twiddle-frob-mode-line-format) (setq twiddle-timer (apply 'twiddle-timer-start 0 (or delay twiddle-delay) fn fn-args))) (defun twiddle-initialize-data (len init-char) (if (stringp init-char) (setq twiddle-mode-string (copy-sequence init-char)) (setq twiddle-mode-string (make-string len init-char))) (setq twiddle-current-pos 0) (setq twiddle-current-saved-char (aref twiddle-mode-string twiddle-current-pos)) (setq twiddle-direction '1+) (and twiddle-properties (boundp 'add-text-properties) (add-text-properties 0 len twiddle-properties twiddle-mode-string))) ;; Edit global mode-line-format to include the twiddles. ;; "Destructively" modifies the global mode-line-format list, since XEmacs ;; makes the symbol local in every buffer. (defun twiddle-frob-mode-line-format () (let* ((format (default-value 'mode-line-format)) ;; XEmacs 19.14 has "-%-" as the last elt by default. (end (or (member "%-" format) (member "-%-" format)))) (cond (end (setcdr end (cons (car end) (cdr end))) (setcar end 'twiddle-mode-string)) (t (nconc format 'twiddle-mode-string))))) (defun twiddle-unfrob-mode-line-format () (setq-default mode-line-format (delq 'twiddle-mode-string (default-value 'mode-line-format)))) ;; Insert NEW-ELT in the INDEX position of LIST. ;; LIST is destructively modified. (defun twiddle-insert (list new-elt index) (let ((inspoint (nthcdr index list))) (cond ((consp inspoint) (setcdr inspoint (cons (car inspoint) (cdr inspoint))) (setcar inspoint new-elt)) ((> index (length list)) (signal 'error (list "List too short" list new-elt index))) (t (nconc list (cons new-elt nil))))) list) (defun twiddle-read-hack-complete () (completing-read "Twiddle hack: " twiddle-hacks nil t twiddle-default-hack)) ;; Return a function of no arguments which calls fn with args. ;; The args are quoted to avoid double-evaluation: they are evaluated ;; when passed to twiddle-make-thunk, never afterward. (defun twiddle-make-thunk (fn args) (and (symbolp fn) (setq fn (list 'quote fn))) (list 'lambda '() (list 'apply fn (list 'quote args)))) ;; Returns the timer object. (defun twiddle-timer-start (secs repeat function &rest args) (cond (twiddle-xemacs-p ;; The initial timeout must be greater than zero. (and (zerop secs) (setq secs (1+ secs))) ;; The XEmacs timer interface doesn't allow one to specify ;; arguments to the function to call, but we can work around this ;; by wrapping the call in a thunk. (start-itimer "twiddle" (if args (twiddle-make-thunk function args) function) secs repeat)) (t (apply 'run-with-timer secs repeat function args)))) (defun twiddle-timer-stop (timer) (cond (twiddle-xemacs-p (and (itimerp timer) (delete-itimer timer))) ((timerp timer) ;; If this function is called from the timer itself, the timer ;; object isn't present on timer-list so cancel-timer won't do ;; anything useful. To work around this case, disable the timer ;; repeat so it will expire on its own. (timer-set-time timer '(0 0) 0) (cancel-timer timer)))) ;; Subroutine of twiddle-compile. (defun twiddle-frob-compile (&optional twiddle-fn &rest args) (if compilation-in-progress (apply (or twiddle-fn (nth 1 (assoc twiddle-default-hack twiddle-hacks))) args) (twiddle-stop))) (defalias 'twiddle-mode-line-update (if twiddle-xemacs-p 'redraw-modeline 'force-mode-line-update)) ;;; Hacks. (defun twiddle-frob-twiddle () (setq twiddle-current-pos 0) (while (< twiddle-current-pos (length twiddle-mode-string)) (setq twiddle-current-saved-char (memq (aref twiddle-mode-string twiddle-current-pos) twiddle-rotate-chars)) (and twiddle-current-saved-char (aset twiddle-mode-string twiddle-current-pos (or (car (cdr twiddle-current-saved-char)) (car twiddle-rotate-chars)))) (setq twiddle-current-pos (1+ twiddle-current-pos))) (twiddle-mode-line-update)) (defun twiddle-frob-roll () (setq twiddle-temp (or (car (cdr (memq (aref twiddle-mode-string twiddle-current-pos) twiddle-rotate-chars))) (car twiddle-rotate-chars))) (cond ((= twiddle-current-pos 0) (setq twiddle-direction '1+)) ((= twiddle-current-pos (1- (length twiddle-mode-string))) (setq twiddle-direction '1-))) (aset twiddle-mode-string twiddle-current-pos twiddle-current-saved-char) (setq twiddle-current-pos (funcall twiddle-direction twiddle-current-pos)) (setq twiddle-current-saved-char (aref twiddle-mode-string twiddle-current-pos)) (aset twiddle-mode-string twiddle-current-pos twiddle-temp) (twiddle-mode-line-update)) (defun twiddle-frob-asterisk () (aset twiddle-mode-string twiddle-current-pos twiddle-current-saved-char) (cond ((= twiddle-current-pos 0) (setq twiddle-direction '1+)) ((= twiddle-current-pos (1- (length twiddle-mode-string))) (setq twiddle-direction '1-))) (setq twiddle-current-pos (funcall twiddle-direction twiddle-current-pos)) (setq twiddle-current-saved-char (aref twiddle-mode-string twiddle-current-pos)) (aset twiddle-mode-string twiddle-current-pos ?*) (twiddle-mode-line-update)) (provide 'twiddle) ;;; twiddle.el ends here. emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/apache-mode.el0000775000000000000000000004347612230377265021751 0ustar ;;; apache-mode.el --- major mode for editing Apache configuration files ;; Copyright (c) 2004, 2005 Karl Chen ;; Copyright (c) 1999 Jonathan Marten ;; Author: Karl Chen ;; Keywords: languages, faces ;; Last edit: 2005-01-06 ;; Version: 2.0 $Id: apache-mode.el,v 1.5 2009-09-03 14:41:25 psg Exp $ ;; apache-mode.el 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 2, or (at your option) any later ;; version. ;; ;; It 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 your copy of Emacs; see the file COPYING. If not, write to the Free ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. ;;; Commentary: ;; ;; (autoload 'apache-mode "apache-mode" nil t) ;; (add-to-list 'auto-mode-alist '("\\.htaccess\\'" . apache-mode)) ;; (add-to-list 'auto-mode-alist '("httpd\\.conf\\'" . apache-mode)) ;; (add-to-list 'auto-mode-alist '("srm\\.conf\\'" . apache-mode)) ;; (add-to-list 'auto-mode-alist '("access\\.conf\\'" . apache-mode)) ;; (add-to-list 'auto-mode-alist '("sites-\\(available\\|enabled\\)/" . apache-mode)) ;; ;;; History: ;; 1999-10 Jonathan Marten ;; initial version ;; 2004-09-12 Karl Chen ;; rewrote pretty much everything using define-derived-mode; added support ;; for Apache 2.x; fixed highlighting in GNU Emacs; created indentation ;; function ;; ;; 2005-06-29 Kumar Appaiah ;; use syntax table instead of font-lock-keywords to highlight comments. ;;; Code: ;; Requires (require 'regexp-opt) (defvar apache-indent-level 4 "*Number of spaces to indent per level") (defvar apache-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?_ "_" table) (modify-syntax-entry ?- "_" table) (modify-syntax-entry ?( "()" table) (modify-syntax-entry ?) ")(" table) (modify-syntax-entry ?< "(>" table) (modify-syntax-entry ?> ")<" table) (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?, "." table) (modify-syntax-entry ?# "<" table) (modify-syntax-entry ?\n ">#" table) table)) ;;;###autoload (define-derived-mode apache-mode fundamental-mode "Apache" "Major mode for editing Apache configuration files." (set (make-local-variable 'comment-start) "# ") (set (make-local-variable 'comment-start-skip) "#\\W*") (set (make-local-variable 'comment-column) 48) (set (make-local-variable 'indent-line-function) 'apache-indent-line) (set (make-local-variable 'font-lock-defaults) '(apache-font-lock-keywords nil t ((?_ . "w") (?- . "w")) beginning-of-line))) ;; Font lock (defconst apache-font-lock-keywords (purecopy (list ;; see syntax table for comment highlighting ;; (list "^[ \t]*#.*" 0 'font-lock-comment-face t) (list (concat ; sections "^[ \t]*") 1 'font-lock-function-name-face) (list (concat ; directives "^[ \t]*" (regexp-opt ' ( "AcceptMutex" "AcceptPathInfo" "AccessConfig" "AccessFileName" "Action" "AddAlt" "AddAltByEncoding" "AddAltByType" "AddCharset" "AddDefaultCharset" "AddDescription" "AddEncoding" "AddHandler" "AddIcon" "AddIconByEncoding" "AddIconByType" "AddInputFilter" "AddLanguage" "AddModule" "AddModuleInfo" "AddOutputFilter" "AddOutputFilterByType" "AddType" "AgentLog" "Alias" "AliasMatch" "Allow from" "Allow" "AllowCONNECT" "AllowEncodedSlashes" "AllowOverride" "Anonymous" "Anonymous_Authoritative" "Anonymous_LogEmail" "Anonymous_MustGiveEmail" "Anonymous_NoUserID" "Anonymous_VerifyEmail" "AssignUserID" "AuthAuthoritative" "AuthDBAuthoritative" "AuthDBGroupFile" "AuthDBMAuthoritative" "AuthDBMGroupFile" "AuthDBMType" "AuthDBMUserFile" "AuthDBUserFile" "AuthDigestAlgorithm" "AuthDigestDomain" "AuthDigestFile" "AuthDigestGroupFile" "AuthDigestNcCheck" "AuthDigestNonceFormat" "AuthDigestNonceLifetime" "AuthDigestQop" "AuthDigestShmemSize" "AuthGroupFile" "AuthLDAPAuthoritative" "AuthLDAPBindDN" "AuthLDAPBindPassword" "AuthLDAPCharsetConfig" "AuthLDAPCompareDNOnServer" "AuthLDAPDereferenceAliases" "AuthLDAPEnabled" "AuthLDAPFrontPageHack" "AuthLDAPGroupAttribute" "AuthLDAPGroupAttributeIsDN" "AuthLDAPRemoteUserIsDN" "AuthLDAPUrl" "AuthName" "AuthType" "AuthUserFile" "BS2000Account" "BindAddress" "BrowserMatch" "BrowserMatchNoCase" "CGIMapExtension" "CacheDefaultExpire" "CacheDirLength" "CacheDirLevels" "CacheDisable" "CacheEnable" "CacheExpiryCheck" "CacheFile" "CacheForceCompletion" "CacheGcClean" "CacheGcDaily" "CacheGcInterval" "CacheGcMemUsage" "CacheGcUnused" "CacheIgnoreCacheControl" "CacheIgnoreNoLastMod" "CacheLastModifiedFactor" "CacheMaxExpire" "CacheMaxFileSize" "CacheMinFileSize" "CacheNegotiatedDocs" "CacheRoot" "CacheSize" "CacheTimeMargin" "CharsetDefault" "CharsetOptions" "CharsetSourceEnc" "CheckSpelling" "ChildPerUserID" "ClearModuleList" "ContentDigest" "CookieDomain" "CookieExpires" "CookieLog" "CookieName" "CookieStyle" "CookieTracking" "CoreDumpDirectory" "CustomLog" "Dav" "DavDepthInfinity" "DavLockDB" "DavMinTimeout" "DefaultIcon" "DefaultLanguage" "DefaultMode" "DefaultType" "DeflateBufferSize" "DeflateCompressionLevel" "DeflateFilterNote" "DeflateMemLevel" "DeflateWindowSize" "Deny" "DirectoryIndex" "DirectorySlash" "DocTitle" "DocTrailer" "DocumentRoot" "EnableExceptionHook" "EnableMMAP" "EnableSendfile" "ErrorDocument" "ErrorLog" "Example" "ExpiresActive" "ExpiresByType" "ExpiresDefault" "ExtFilterDefine" "ExtFilterOptions" "ExtendedStatus" "FancyIndexing" "FileETag" "ForceLanguagePriority" "ForceType" "ForensicLog" "Group" "HTMLDir" "HTTPLogFile" "HeadPrefix" "HeadSuffix" "Header" "HeaderName" "HideSys" "HideURL" "HostNameLookups" "HostnameLookups" "ISAPIAppendLogToErrors" "ISAPIAppendLogToQuery" "ISAPICacheFile" "ISAPIFakeAsync" "ISAPILogNotSupported" "ISAPIReadAheadBuffer" "IdentityCheck" "ImapBase" "ImapDefault" "ImapMenu" "Include" "IndexIgnore" "IndexOptions" "IndexOrderDefault" "KeepAlive" "KeepAliveTimeout" "LDAPCacheEntries" "LDAPCacheTTL" "LDAPOpCacheEntries" "LDAPOpCacheTTL" "LDAPSharedCacheFile" "LDAPSharedCacheSize" "LDAPTrustedCA" "LDAPTrustedCAType" "LanguagePriority" "LastURLs" "LimitInternalRecursion" "LimitRequestBody" "LimitRequestFields" "LimitRequestFieldsize" "LimitRequestLine" "LimitXMLRequestBody" "Listen" "ListenBacklog" "LoadFile" "LoadModule" "LockFile" "LogFormat" "LogLevel" "MCacheMaxObjectCount" "MCacheMaxObjectSize" "MCacheMaxStreamingBuffer" "MCacheMinObjectSize" "MCacheRemovalAlgorithm" "MCacheSize" "MMapFile" "MaxClients" "MaxKeepAliveRequests" "MaxMemFree" "MaxRequestsPerChild" "MaxRequestsPerThread" "MaxSpareServers" "MaxSpareThreads" "MaxThreads" "MaxThreadsPerChild" "MetaDir" "MetaFiles" "MetaSuffix" "MimeMagicFile" "MinSpareServers" "MinSpareThreads" "ModMimeUsePathInfo" "MultiviewsMatch" "NWSSLTrustedCerts" "NWSSLUpgradeable" "NameVirtualHost" "NoCache" "NoProxy" "NumServers" "Options" "Order" "PassEnv" "PidFile" "Port" "PrivateDir" "ProtocolEcho" "ProxyBadHeader" "ProxyBlock" "ProxyDomain" "ProxyErrorOverride" "ProxyIOBufferSize" "ProxyMaxForwards" "ProxyPass" "ProxyPassReverse" "ProxyPreserveHost" "ProxyReceiveBufferSize" "ProxyRemote" "ProxyRemoteMatch" "ProxyRequests" "ProxyTimeout" "ProxyVia" "RLimitCPU" "RLimitMEM" "RLimitNPROC" "ReadmeName" "Redirect" "RedirectMatch" "RedirectPermanent" "RedirectTemp" "RefererIgnore" "RefererLog" "RemoveCharset" "RemoveEncoding" "RemoveHandler" "RemoveInputFilter" "RemoveLanguage" "RemoveOutputFilter" "RemoveType" "RequestHeader" "Require" "ResourceConfig" "RewriteBase" "RewriteCond" "RewriteEngine" "RewriteLock" "RewriteLog" "RewriteLogLevel" "RewriteMap" "RewriteOptions" "RewriteRule" "SSIEndTag" "SSIErrorMsg" "SSIStartTag" "SSITimeFormat" "SSIUndefinedEcho" "SSLCACertificateFile" "SSLCACertificatePath" "SSLCARevocationFile" "SSLCARevocationPath" "SSLCertificateChainFile" "SSLCertificateFile" "SSLCertificateKeyFile" "SSLCipherSuite" "SSLEngine" "SSLMutex" "SSLOptions" "SSLPassPhraseDialog" "SSLProtocol" "SSLProxyCACertificateFile" "SSLProxyCACertificatePath" "SSLProxyCARevocationFile" "SSLProxyCARevocationPath" "SSLProxyCipherSuite" "SSLProxyEngine" "SSLProxyMachineCertificateFile" "SSLProxyMachineCertificatePath" "SSLProxyProtocol" "SSLProxyVerify" "SSLProxyVerifyDepth" "SSLRandomSeed" "SSLRequire" "SSLRequireSSL" "SSLSessionCache" "SSLSessionCacheTimeout" "SSLVerifyClient" "SSLVerifyDepth" "Satisfy" "ScoreBoardFile" "Script" "ScriptAlias" "ScriptAliasMatch" "ScriptInterpreterSource" "ScriptLog" "ScriptLogBuffer" "ScriptLogLength" "ScriptSock" "SecureListen" "SendBufferSize" "ServerAdmin" "ServerAlias" "ServerLimit" "ServerName" "ServerPath" "ServerRoot" "ServerSignature" "ServerTokens" "ServerType" "SetEnv" "SetEnvIf" "SetEnvIfNoCase" "SetHandler" "SetInputFilter" "SetOutputFilter" "StartServers" "StartThreads" "SuexecUserGroup" "ThreadLimit" "ThreadStackSize" "ThreadsPerChild" "TimeOut" "TopSites" "TopURLs" "TransferLog" "TypesConfig" "UnsetEnv" "UseCanonicalName" "User" "UserDir" "VirtualDocumentRoot" "VirtualDocumentRootIP" "VirtualScriptAlias" "VirtualScriptAliasIP" "Win32DisableAcceptEx" "XBitHack" "deny" "order" "require" ) 'words)) 1 'font-lock-keyword-face) (list ; values (regexp-opt ' ( "All" "AuthConfig" "Basic" "CONNECT" "DELETE" "Digest" "ExecCGI" "FancyIndexing" "FileInfo" "FollowSymLinks" "Full" "GET" "IconsAreLinks" "Includes" "IncludesNOEXEC" "Indexes" "Limit" "Minimal" "MultiViews" "None" "OPTIONS" "OS" "Options" "Options" "POST" "PUT" "ScanHTMLTitles" "SuppressDescription" "SuppressLastModified" "SuppressSize" "SymLinksIfOwnerMatch" "URL" "add" "allow" "any" "append" "deny" "double" "downgrade-1.0" "email" "env" "error" "force-response-1.0" "formatted" "from" "full" "gone" "group" "inetd" "inherit" "map" "mutual-failure" "nocontent" "nokeepalive" "none" "off" "on" "permanent" "referer" "seeother" "semi-formatted" "set" "standalone" "temporary" "unformatted" "unset" "user" "valid-user" ) 'words) 1 'font-lock-type-face))) "Expressions to highlight in Apache config buffers.") (defun apache-indent-line () "Indent current line of Apache code." (interactive) (let ((savep (> (current-column) (current-indentation))) (indent (max (apache-calculate-indentation) 0))) (if savep (save-excursion (indent-line-to indent)) (indent-line-to indent)))) (defun apache-previous-indentation () ;; Return the previous (non-empty/comment) indentation. Doesn't save ;; position. (let (indent) (while (and (null indent) (zerop (forward-line -1))) (unless (looking-at "[ \t]*\\(#\\|$\\)") (setq indent (current-indentation)))) (or indent 0))) (defun apache-calculate-indentation () ;; Return the amount the current line should be indented. (save-excursion (forward-line 0) (if (bobp) 0 (let ((ends-section-p (looking-at "[ \t]* ;; Keywords: hypermedia, extensions ;; 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 2, 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; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; This package converts the buffer text and the associated ;; decorations to HTML. Mail to to discuss ;; features and additions. All suggestions are more than welcome. ;; To use this, just switch to the buffer you want HTML-ized and type ;; `M-x htmlize-buffer'. You will be switched to a new buffer that ;; contains the resulting HTML code. You can edit and inspect this ;; buffer, or you can just save it with C-x C-w. `M-x htmlize-file' ;; will find a file, fontify it, and save the HTML version in ;; FILE.html, without any additional intervention. `M-x ;; htmlize-many-files' allows you to htmlize any number of files in ;; the same manner. `M-x htmlize-many-files-dired' does the same for ;; files marked in a dired buffer. ;; htmlize supports three types of HTML output, selected by setting ;; `htmlize-output-type': `css', `inline-css', and `font'. In `css' ;; mode, htmlize uses cascading style sheets to specify colors; it ;; generates classes that correspond to Emacs faces and uses ... to color parts of text. In this mode, the ;; produced HTML is valid under the 4.01 strict DTD, as confirmed by ;; the W3C validator. `inline-css' is like `css', except the CSS is ;; put directly in the STYLE attribute of the SPAN element, making it ;; possible to paste the generated HTML to other documents. In `font' ;; mode, htmlize uses ... to colorize HTML, ;; which is not standard-compliant, but works better in older ;; browsers. `css' mode is the default. ;; You can also use htmlize from your Emacs Lisp code. When called ;; non-interactively, `htmlize-buffer' and `htmlize-region' will ;; return the resulting HTML buffer, but will not change current ;; buffer or move the point. ;; I tried to make the package elisp-compatible with multiple Emacsen, ;; specifically aiming for XEmacs 19.14+ and GNU Emacs 19.34+. Please ;; let me know if it doesn't work on some of those, and I'll try to ;; fix it. I relied heavily on the presence of CL extensions, ;; especially for cross-emacs compatibility; please don't try to ;; remove that particular dependency. When byte-compiling under GNU ;; Emacs, you're likely to get some warnings; just ignore them. ;; The latest version should be available at: ;; ;; ;; ;; You can find a sample of htmlize's output (possibly generated with ;; an older version) at: ;; ;; ;; Thanks go to the multitudes of people who have sent reports and ;; contributed comments, suggestions, and fixes. They include Ron ;; Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels, Juri ;; Linkov, Maciek Pasternacki, and many others. ;; User quotes: "You sir, are a sick, sick, _sick_ person. :)" ;; -- Bill Perry, author of Emacs/W3 ;;; Code: (require 'cl) (eval-when-compile (if (string-match "XEmacs" emacs-version) (byte-compiler-options (warnings (- unresolved)))) (defvar font-lock-auto-fontify) (defvar font-lock-support-mode) (defvar global-font-lock-mode) (when (and (eq emacs-major-version 19) (not (string-match "XEmacs" emacs-version))) ;; Older versions of GNU Emacs fail to autoload cl-extra even when ;; `cl' is loaded. (load "cl-extra"))) (defconst htmlize-version "1.36") ;; Incantations to make custom stuff work without customize, e.g. on ;; XEmacs 19.14 or GNU Emacs 19.34. (eval-and-compile (condition-case () (require 'custom) (error nil)) (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) nil ; we've got what we needed ;; No custom or obsolete custom, define surrogates. Define all ;; three macros, so we don't hose another library that expects ;; e.g. `defface' to work after (fboundp 'defcustom) succeeds. (defmacro defgroup (&rest ignored) nil) (defmacro defcustom (var value doc &rest ignored) `(defvar ,var ,value ,doc)) (defmacro defface (face value doc &rest stuff) `(make-face ,face)))) (defgroup htmlize nil "Convert buffer text and faces to HTML." :group 'hypermedia) (defcustom htmlize-head-tags "" "*Additional tags to insert within HEAD of the generated document." :type 'string :group 'htmlize) (defcustom htmlize-output-type 'css "*Output type of generated HTML, one of `css', `inline-css', or `font'. When set to `css' (the default), htmlize will generate a style sheet with description of faces, and use it in the HTML document, specifying the faces in the actual text with . When set to `inline-css', the style will be generated as above, but placed directly in the STYLE attribute of the span ELEMENT: . This makes it easier to paste the resulting HTML to other documents. When set to `font', the properties will be set using layout tags , , , , and . `css' output is normally preferred, but `font' is still useful for supporting old, pre-CSS browsers, and both `inline-css' and `font' for easier embedding of colorized text in foreign HTML documents (no style sheet to carry around)." :type '(choice (const css) (const inline-css) (const font)) :group 'htmlize) (defcustom htmlize-generate-hyperlinks t "*Non-nil means generate the hyperlinks for URLs and mail addresses. This is on by default; set it to nil if you don't want htmlize to insert hyperlinks in the resulting HTML. (In which case you can still do your own hyperlinkification from htmlize-after-hook.)" :type 'boolean :group 'htmlize) (defcustom htmlize-hyperlink-style " a { color: inherit; background-color: inherit; font: inherit; text-decoration: inherit; } a:hover { text-decoration: underline; } " "*The CSS style used for hyperlinks when in CSS mode." :type 'string :group 'htmlize) (defcustom htmlize-replace-form-feeds t "*Non-nil means replace form feeds in source code with HTML separators. Form feeds are the ^L characters at line beginnings that are sometimes used to separate sections of source code. If this variable is set to `t', form feed characters are replaced with the
separator. If this is a string, it specifies the replacement to use. Note that 
 is
temporarily closed before the separator is inserted, so the default
replacement is effectively \"
\".  If you specify
another replacement, don't forget to close and reopen the 
 if you
want the output to remain valid HTML.

If you need more elaborate processing, set this to nil and use
htmlize-after-hook."
  :type 'boolean
  :group 'htmlize)

(defcustom htmlize-html-charset nil
  "*The charset declared by the resulting HTML documents.
When non-nil, causes htmlize to insert the following in the HEAD section
of the generated HTML:

  

where CHARSET is the value you've set for htmlize-html-charset.  Valid
charsets are defined by MIME and include strings like \"iso-8859-1\",
\"iso-8859-15\", \"utf-8\", etc.

If you are using non-Latin-1 charsets, you might need to set this for
your documents to render correctly.  Also, the W3C validator requires
submitted HTML documents to declare a charset.  So if you care about
validation, you can use this to prevent the validator from bitching.

Needless to say, if you set this, you should actually make sure that
the buffer is in the encoding you're claiming it is in.  (Under Mule
that is done by ensuring the correct \"file coding system\" for the
buffer.)  If you don't understand what that means, this option is
probably not for you."
  :type '(choice (const :tag "Unset" nil)
		 string)
  :group 'htmlize)

(defcustom htmlize-convert-nonascii-to-entities (featurep 'mule)
  "*Whether non-ASCII characters should be converted to HTML entities.

When this is non-nil, characters with codes in the 128-255 range will be
considered Latin 1 and rewritten as \"&#CODE;\".  Characters with codes
above 255 will be converted to \"&#UCS;\", where UCS denotes the Unicode
code point of the character.  If the code point cannot be determined,
the character will be copied unchanged, as would be the case if the
option were nil.

When the option is nil, the non-ASCII characters are copied to HTML
without modification.  In that case, the web server and/or the browser
must be set to understand the encoding that was used when saving the
buffer.  (You might also want to specify it by setting
`htmlize-html-charset'.)

Note that in an HTML entity \"&#CODE;\", CODE is always a UCS code point,
which has nothing to do with the charset the page is in.  For example,
\"©\" *always* refers to the copyright symbol, regardless of charset
specified by the META tag or the charset sent by the HTTP server.  In
other words, \"©\" is exactly equivalent to \"©\".

By default, entity conversion is turned on for Mule-enabled Emacsen and
turned off otherwise.  This is because Mule knows the charset of
non-ASCII characters in the buffer.  A non-Mule Emacs cannot tell
whether a character with code 0xA9 represents Latin 1 copyright symbol,
Latin 2 \"S with caron\", or something else altogether.  Setting this to
t without Mule means asserting that 128-255 characters always mean Latin
1.

For most people htmlize will work fine with this option left at the
default setting; don't change it unless you know what you're doing."
  :type 'sexp
  :group 'htmlize)

(defcustom htmlize-ignore-face-size 'absolute
  "*Whether face size should be ignored when generating HTML.
If this is nil, face sizes are used.  If set to t, sizes are ignored
If set to `absolute', only absolute size specifications are ignored.
Please note that font sizes only work with CSS-based output types."
  :type '(choice (const :tag "Don't ignore" nil)
		 (const :tag "Ignore all" t)
		 (const :tag "Ignore absolute" absolute))
  :group 'htmlize)

(defcustom htmlize-css-name-prefix ""
  "*The prefix used for CSS names.
The CSS names that htmlize generates from face names are often too
generic for CSS files; for example, `font-lock-type-face' is transformed
to `type'.  Use this variable to add a prefix to the generated names.
The string \"htmlize-\" is an example of a reasonable prefix."
  :type 'string
  :group 'htmlize)

(defcustom htmlize-use-rgb-txt t
  "*Whether `rgb.txt' should be used to convert color names to RGB.

This conversion means determining, for instance, that the color
\"IndianRed\" corresponds to the (205, 92, 92) RGB triple.  `rgb.txt'
is the X color database that maps hundreds of color names to such RGB
triples.  When this variable is non-nil, `htmlize' uses `rgb.txt' to
look up color names.

If this variable is nil, htmlize queries Emacs for RGB components of
colors using `color-instance-rgb-components' and `x-color-values'.
This can yield incorrect results on non-true-color displays.

If the `rgb.txt' file is not found (which will be the case if you're
running Emacs on non-X11 systems), this option is ignored."
  :type 'boolean
  :group 'htmlize)

(defcustom htmlize-html-major-mode nil
  "The mode the newly created HTML buffer will be put in.
Set this to nil if you prefer the default (fundamental) mode."
  :type '(radio (const :tag "No mode (fundamental)" nil)
		 (function-item html-mode)
		 (function :tag "User-defined major mode"))
  :group 'htmlize)

(defvar htmlize-before-hook nil
  "Hook run before htmlizing a buffer.
The hook functions are run in the source buffer (not the resulting HTML
buffer).")

(defvar htmlize-after-hook nil
  "Hook run after htmlizing a buffer.
Unlike `htmlize-before-hook', these functions are run in the generated
HTML buffer.  You may use them to modify the outlook of the final HTML
output.")

(defvar htmlize-file-hook nil
  "Hook run by `htmlize-file' after htmlizing a file, but before saving it.")

(defvar htmlize-buffer-places)

;;; Some cross-Emacs compatibility.

;; I try to conditionalize on features rather than Emacs version, but
;; in some cases checking against the version *is* necessary.
(defconst htmlize-running-xemacs (string-match "XEmacs" emacs-version))

(eval-and-compile
  ;; save-current-buffer, with-current-buffer, and with-temp-buffer
  ;; are not available in 19.34 and in older XEmacsen.  Strictly
  ;; speaking, we should stick to our own namespace and define and use
  ;; htmlize-save-current-buffer, etc.  But non-standard special forms
  ;; are a pain because they're not properly fontified or indented and
  ;; because they look weird and ugly.  So I'll just go ahead and
  ;; define the real ones if they're not available.  If someone
  ;; convinces me that this breaks something, I'll switch to the
  ;; "htmlize-" namespace.
  (unless (fboundp 'save-current-buffer)
    (defmacro save-current-buffer (&rest forms)
      `(let ((__scb_current (current-buffer)))
	 (unwind-protect
	     (progn ,@forms)
	   (set-buffer __scb_current)))))
  (unless (fboundp 'with-current-buffer)
    (defmacro with-current-buffer (buffer &rest forms)
      `(save-current-buffer (set-buffer ,buffer) ,@forms)))
  (unless (fboundp 'with-temp-buffer)
    (defmacro with-temp-buffer (&rest forms)
      (let ((temp-buffer (gensym "tb-")))
	`(let ((,temp-buffer
		(get-buffer-create (generate-new-buffer-name " *temp*"))))
	   (unwind-protect
	       (with-current-buffer ,temp-buffer
		 ,@forms)
	     (and (buffer-live-p ,temp-buffer)
		  (kill-buffer ,temp-buffer))))))))

;; We need a function that efficiently finds the next change of a
;; property (usually `face'), preferably regardless of whether the
;; change occurred because of a text property or an extent/overlay.
;; As it turns out, it is not easy to do that compatibly.
;;
;; Under XEmacs, `next-single-property-change' does that.  Under GNU
;; Emacs beginning with version 21, `next-single-char-property-change'
;; is available and does the same.  GNU Emacs 20 had
;; `next-char-property-change', which we can use.  GNU Emacs 19 didn't
;; provide any means for simultaneously examining overlays and text
;; properties, so when using Emacs 19.34, we punt and fall back to
;; `next-single-property-change', thus ignoring overlays altogether.

(cond
 (htmlize-running-xemacs
  ;; XEmacs: good.
  (defun htmlize-next-change (pos prop &optional limit)
    (next-single-property-change pos prop nil (or limit (point-max)))))
 ((fboundp 'next-single-char-property-change)
  ;; GNU Emacs 21: good.
  (defun htmlize-next-change (pos prop &optional limit)
    (next-single-char-property-change pos prop nil limit)))
 ((fboundp 'next-char-property-change)
  ;; GNU Emacs 20: bad, but fixable.
  (defun htmlize-next-change (pos prop &optional limit)
    (let ((done nil)
	  (current-value (get-char-property pos prop))
	  newpos next-value)
      ;; Loop over positions returned by next-char-property-change
      ;; until the value of PROP changes or we've hit EOB.
      (while (not done)
	(setq newpos (next-char-property-change pos limit)
	      next-value (get-char-property newpos prop))
	(cond ((eq newpos pos)
	       ;; Possibly at EOB?  Whatever, just don't infloop.
	       (setq done t))
	      ((eq next-value current-value)
	       ;; PROP hasn't changed -- keep looping.
	       )
	      (t
	       (setq done t)))
	(setq pos newpos))
      pos)))
 (t
  ;; GNU Emacs 19.34: hopeless, cannot properly support overlays.
  (defun htmlize-next-change (pos prop &optional limit)
    (unless limit
      (setq limit (point-max)))
    (let ((res (next-single-property-change pos prop)))
      (if (or (null res)
	      (> res limit))
	  limit
	res)))))

;;; Transformation of buffer text: HTML escapes, untabification, etc.

(defvar htmlize-basic-character-table
  ;; Map characters in the 0-127 range to either one-character strings
  ;; or to numeric entities.
  (let ((table (make-vector 128 ?\0)))
    ;; Map characters in the 32-126 range to themselves, others to
    ;; &#CODE entities;
    (dotimes (i 128)
      (setf (aref table i) (if (and (>= i 32) (<= i 126))
			       (char-to-string i)
			     (format "&#%d;" i))))
    ;; Set exceptions manually.
    (setf
     ;; Don't escape newline, carriage return, and TAB.
     (aref table ?\n) "\n"
     (aref table ?\r) "\r"
     (aref table ?\t) "\t"
     ;; Escape &, <, and >.
     (aref table ?&) "&"
     (aref table ?<) "<"
     (aref table ?>) ">"
     ;; Not escaping '"' buys us a measurable speedup.  It's only
     ;; necessary to quote it for strings used in attribute values,
     ;; which htmlize doesn't do.
     ;(aref table ?\") """
     )
    table))

;; A cache of HTML representation of non-ASCII characters.  Depending
;; on availability of `encode-char' and the setting of
;; `htmlize-convert-nonascii-to-entities', this maps non-ASCII
;; characters to either "&#;" or "" (mapconcat's mapper
;; must always return strings).  It's only filled as characters are
;; encountered, so that in a buffer with e.g. French text, it will
;; only ever contain French accented characters as keys.  It's cleared
;; on each entry to htmlize-buffer-1 to allow modifications of
;; `htmlize-convert-nonascii-to-entities' to take effect.
(defvar htmlize-extended-character-cache (make-hash-table :test 'eq))

(defun htmlize-protect-string (string)
  "HTML-protect string, escaping HTML metacharacters and I18N chars."
  ;; Only protecting strings that actually contain unsafe or non-ASCII
  ;; chars removes a lot of unnecessary funcalls and consing.
  (if (not (string-match "[^\r\n\t -%'-;=?-~]" string))
      string
    (mapconcat (lambda (char)
		 (cond
		  ((< char 128)
		   ;; ASCII: use htmlize-basic-character-table.
		   (aref htmlize-basic-character-table char))
		  ((gethash char htmlize-extended-character-cache)
		   ;; We've already seen this char; return the cached
		   ;; string.
		   )
		  ((not htmlize-convert-nonascii-to-entities)
		   ;; If conversion to entities is not desired, always
		   ;; copy the char literally.
		   (setf (gethash char htmlize-extended-character-cache)
			 (char-to-string char)))
		  ((< char 256)
		   ;; Latin 1: no need to call encode-char.
		   (setf (gethash char htmlize-extended-character-cache)
			 (format "&#%d;" char)))
		  ((and (fboundp 'encode-char)
			;; Must check if encode-char works for CHAR;
			;; it fails for Arabic and possibly elsewhere.
			(encode-char char 'ucs))
		   (setf (gethash char htmlize-extended-character-cache)
			 (format "&#%d;" (encode-char char 'ucs))))
		  (t
		   ;; encode-char doesn't work for this char.  Copy it
		   ;; unchanged and hope for the best.
		   (setf (gethash char htmlize-extended-character-cache)
			 (char-to-string char)))))
	       string "")))

(defconst htmlize-ellipsis "...")
(put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis)

(defun htmlize-buffer-substring-no-invisible (beg end)
  ;; Like buffer-substring-no-properties, but don't copy invisible
  ;; parts of the region.  Where buffer-substring-no-properties
  ;; mandates an ellipsis to be shown, htmlize-ellipsis is inserted.
  (let ((pos beg)
	visible-list invisible show next-change)
    ;; Iterate over the changes in the `invisible' property and filter
    ;; out the portions where it's non-nil, i.e. where the text is
    ;; invisible.
    (while (< pos end)
      (setq invisible (get-char-property pos 'invisible)
	    next-change (htmlize-next-change pos 'invisible end))
      (if (not (listp buffer-invisibility-spec))
	  ;; If buffer-invisibility-spec is not a list, then all
	  ;; characters with non-nil `invisible' property are visible.
	  (setq show (not invisible))
	;; Otherwise, the value of a non-nil `invisible' property can be:
	;; 1. a symbol -- make the text invisible if it matches
	;;    buffer-invisibility-spec.
	;; 2. a list of symbols -- make the text invisible if
	;;    any symbol in the list matches
	;;    buffer-invisibility-spec.
	;; If the match of buffer-invisibility-spec has a non-nil
	;; CDR, replace the invisible text with an ellipsis.
	(let (match)
	  (if (symbolp invisible)
	      (setq match (member* invisible buffer-invisibility-spec
				   :key (lambda (i)
					  (if (symbolp i) i (car i)))))
	    (setq match (block nil
			  (dolist (elem invisible)
			    (let ((m (member*
				      elem buffer-invisibility-spec
				      :key (lambda (i)
					     (if (symbolp i) i (car i))))))
			      (when m (return m))))
			  nil)))
	  (setq show (cond ((null match) t)
			   ((and (cdr-safe (car match))
				 ;; Conflate successive ellipses.
				 (not (eq show htmlize-ellipsis)))
			    htmlize-ellipsis)
			   (t nil)))))
      (cond ((eq show t)
	     (push (buffer-substring-no-properties pos next-change) visible-list))
	    ((stringp show)
	     (push show visible-list)))
      (setq pos next-change))
    (if (= (length visible-list) 1)
	;; If VISIBLE-LIST consists of only one element, return it
	;; without concatenation.  This avoids additional consing in
	;; regions without any invisible text.
	(car visible-list)
      (apply #'concat (nreverse visible-list)))))

(defun htmlize-trim-ellipsis (text)
  ;; Remove htmlize-ellipses ("...") from the beginning of TEXT if it
  ;; starts with it.  It checks for the special property of the
  ;; ellipsis so it doesn't work on ordinary text that begins with
  ;; "...".
  (if (get-text-property 0 'htmlize-ellipsis text)
      (substring text (length htmlize-ellipsis))
    text))

(defconst htmlize-tab-spaces
  ;; A table of strings with spaces.  (aref htmlize-tab-spaces 5) is
  ;; like (make-string 5 ?\ ), except it doesn't cons.
  (let ((v (make-vector 32 nil)))
    (dotimes (i (length v))
      (setf (aref v i) (make-string i ?\ )))
    v))

(defun htmlize-untabify (text start-column)
  "Untabify TEXT, assuming it starts at START-COLUMN."
  (let ((column start-column)
	(last-match 0)
	(chunk-start 0)
	chunks match-pos tab-size)
    (while (string-match "[\t\n]" text last-match)
      (setq match-pos (match-beginning 0))
      (cond ((eq (aref text match-pos) ?\t)
	     ;; Encountered a tab: create a chunk of text followed by
	     ;; the expanded tab.
	     (push (substring text chunk-start match-pos) chunks)
	     ;; Increase COLUMN by the length of the text we've
	     ;; skipped since last tab or newline.  (Encountering
	     ;; newline resets it.)
	     (incf column (- match-pos last-match))
	     ;; Calculate tab size based on tab-width and COLUMN.
	     (setq tab-size (- tab-width (% column tab-width)))
	     ;; Expand the tab.
	     (push (aref htmlize-tab-spaces tab-size) chunks)
	     (incf column tab-size)
	     (setq chunk-start (1+ match-pos)))
	    (t
	     ;; Reset COLUMN at beginning of line.
	     (setq column 0)))
      (setq last-match (1+ match-pos)))
    ;; If no chunks have been allocated, it means there have been no
    ;; tabs to expand.  Return TEXT unmodified.
    (if (null chunks)
	text
      (when (< chunk-start (length text))
	;; Push the remaining chunk.
	(push (substring text chunk-start) chunks))
      ;; Generate the output from the available chunks.
      (apply #'concat (nreverse chunks)))))

(defun htmlize-despam-address (string)
  "Replace every occurrence of '@' in STRING with @.
`htmlize-make-hyperlinks' uses this to spam-protect mailto links
without modifying their meaning."
  ;; Suggested by Ville Skytta.
  (while (string-match "@" string)
    (setq string (replace-match "@" nil t string)))
  string)

(defun htmlize-make-hyperlinks ()
  "Make hyperlinks in HTML."
  ;; Function originally submitted by Ville Skytta.  Rewritten by
  ;; Hrvoje Niksic, then modified by Ville Skytta and Hrvoje Niksic.
  (goto-char (point-min))
  (while (re-search-forward
	  "<\\(\\(mailto:\\)?\\([-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+\\)\\)>"
	  nil t)
    (let ((address (match-string 3))
	  (link-text (match-string 1)))
      (delete-region (match-beginning 0) (match-end 0))
      (insert "<"
	      (htmlize-despam-address link-text)
	      ">")))
  (goto-char (point-min))
  (while (re-search-forward "<\\(\\(URL:\\)?\\([a-zA-Z]+://[^;]+\\)\\)>"
			    nil t)
    (let ((url (match-string 3))
	  (link-text (match-string 1)))
      (delete-region (match-beginning 0) (match-end 0))
      (insert "<" link-text ">"))))

;; Tests for htmlize-make-hyperlinks:

;; 
;; 
;; 
;; 
;; 
;; 

(defun htmlize-defang-local-variables ()
  ;; Juri Linkov reports that an HTML-ized "Local variables" can lead
  ;; visiting the HTML to fail with "Local variables list is not
  ;; properly terminated".  He suggested changing the phrase to
  ;; syntactically equivalent HTML that Emacs doesn't recognize.
  (goto-char (point-min))
  (while (search-forward "Local Variables:" nil t)
    (replace-match "Local Variables:" nil t)))
  

;;; Color handling.

(if (fboundp 'locate-file)
    (defalias 'htmlize-locate-file 'locate-file)
  (defun htmlize-locate-file (file path)
    (dolist (dir path nil)
      (when (file-exists-p (expand-file-name file dir))
	(return (expand-file-name file dir))))))

(defvar htmlize-x-library-search-path
  '("/usr/X11R6/lib/X11/"
    "/usr/X11R5/lib/X11/"
    "/usr/lib/X11R6/X11/"
    "/usr/lib/X11R5/X11/"
    "/usr/local/X11R6/lib/X11/"
    "/usr/local/X11R5/lib/X11/"
    "/usr/local/lib/X11R6/X11/"
    "/usr/local/lib/X11R5/X11/"
    "/usr/X11/lib/X11/"
    "/usr/lib/X11/"
    "/usr/local/lib/X11/"
    "/usr/X386/lib/X11/"
    "/usr/x386/lib/X11/"
    "/usr/XFree86/lib/X11/"
    "/usr/unsupported/lib/X11/"
    "/usr/athena/lib/X11/"
    "/usr/local/x11r5/lib/X11/"
    "/usr/lpp/Xamples/lib/X11/"
    "/usr/openwin/lib/X11/"
    "/usr/openwin/share/lib/X11/"))

(defun htmlize-get-color-rgb-hash (&optional rgb-file)
  "Return a hash table mapping X color names to RGB values.
The keys in the hash table are X11 color names, and the values are the
#rrggbb RGB specifications, extracted from `rgb.txt'.

If RGB-FILE is nil, the function will try hard to find a suitable file
in the system directories.

If no rgb.txt file is found, return nil."
  (let ((rgb-file (or rgb-file (htmlize-locate-file
				"rgb.txt"
				htmlize-x-library-search-path)))
	(hash nil))
    (when rgb-file
      (with-temp-buffer
	(insert-file-contents rgb-file)
	(setq hash (make-hash-table :test 'equal))
	(while (not (eobp))
	  (cond ((looking-at "^\\s-*\\([!#]\\|$\\)")
		 ;; Skip comments and empty lines.
		 )
		((looking-at
		  "[ \t]*\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(.*\\)")
		 (setf (gethash (downcase (match-string 4)) hash)
		       (format "#%02x%02x%02x"
			       (string-to-number (match-string 1))
			       (string-to-number (match-string 2))
			       (string-to-number (match-string 3)))))
		(t
		 (error
		  "Unrecognized line in %s: %s"
		  rgb-file
		  (buffer-substring (point) (progn (end-of-line) (point))))))
	  (forward-line 1))))
    hash))

;; Compile the RGB map when loaded.  On systems where rgb.txt is
;; missing, the value of the variable will be nil, and rgb.txt will
;; not be used.
(defvar htmlize-color-rgb-hash (htmlize-get-color-rgb-hash))

;;; Face handling.

(defun htmlize-face-specifies-property (face prop)
  ;; Return t if face specifies PROP, as opposed to it being inherited
  ;; from the default face.  The problem with e.g.
  ;; `face-foreground-instance' is that it returns an instance for
  ;; EVERY face because every face inherits from the default face.
  ;; However, we'd like htmlize-face-{fore,back}ground to return nil
  ;; when called with a face that doesn't specify its own foreground
  ;; or background.
  (or (eq face 'default)
      (assq 'global (specifier-spec-list (face-property face prop)))))

(defun htmlize-face-color-internal (face fg)
  ;; Used only under GNU Emacs.  Return the color of FACE, but don't
  ;; return "unspecified-fg" or "unspecified-bg".  If the face is
  ;; `default' and the color is unspecified, look up the color in
  ;; frame parameters.
  (let* ((function (if fg #'face-foreground #'face-background))
	 color)
    (if (>= emacs-major-version 22)
	;; For GNU Emacs 22+ set INHERIT to get the inherited values.
	(setq color (funcall function face nil t))
      (setq color (funcall function face))
      ;; For GNU Emacs 21 (which has `face-attribute'): if the color
      ;; is nil, recursively check for the face's parent.
      (when (and (null color)
		 (fboundp 'face-attribute)
		 (face-attribute face :inherit)
		 (not (eq (face-attribute face :inherit) 'unspecified)))
	(setq color (htmlize-face-color-internal
		     (face-attribute face :inherit) fg))))
    (when (and (eq face 'default) (null color))
      (setq color (cdr (assq (if fg 'foreground-color 'background-color)
			     (frame-parameters)))))
    (when (or (eq color 'unspecified)
	      (equal color "unspecified-fg")
	      (equal color "unspecified-bg"))
      (setq color nil))
    (when (and (eq face 'default)
	       (null color))
      ;; Assuming black on white doesn't seem right, but I can't think
      ;; of anything better to do.
      (setq color (if fg "black" "white")))
    color))

(defun htmlize-face-foreground (face)
  ;; Return the name of the foreground color of FACE.  If FACE does
  ;; not specify a foreground color, return nil.
  (cond (htmlize-running-xemacs
	 ;; XEmacs.
	 (and (htmlize-face-specifies-property face 'foreground)
	      (color-instance-name (face-foreground-instance face))))
	(t
	 ;; GNU Emacs.
	 (htmlize-face-color-internal face t))))

(defun htmlize-face-background (face)
  ;; Return the name of the background color of FACE.  If FACE does
  ;; not specify a background color, return nil.
  (cond (htmlize-running-xemacs
	 ;; XEmacs.
	 (and (htmlize-face-specifies-property face 'background)
	      (color-instance-name (face-background-instance face))))
	(t
	 ;; GNU Emacs.
	 (htmlize-face-color-internal face nil))))

;; Convert COLOR to the #RRGGBB string.  If COLOR is already in that
;; format, it's left unchanged.

(defun htmlize-color-to-rgb (color)
  (let ((rgb-string nil))
    (cond ((null color)
	   ;; Ignore nil COLOR because it means that the face is not
	   ;; specifying any color.  Hence (htmlize-color-to-rgb nil)
	   ;; returns nil.
	   )
	  ((string-match "\\`#" color)
	   ;; The color is already in #rrggbb format.
	   (setq rgb-string color))
	  ((and htmlize-use-rgb-txt
		htmlize-color-rgb-hash)
	   ;; Use of rgb.txt is requested, and it's available on the
	   ;; system.  Use it.
	   (setq rgb-string (gethash (downcase color) htmlize-color-rgb-hash)))
	  (t
	   ;; We're getting the RGB components from Emacs.
	   (let ((rgb
		  ;; Here I cannot conditionalize on (fboundp ...) 
		  ;; because ps-print under some versions of GNU Emacs
		  ;; defines its own dummy version of
		  ;; `color-instance-rgb-components'.
		  (if htmlize-running-xemacs
		      (mapcar (lambda (arg)
				(/ arg 256))
			      (color-instance-rgb-components
			       (make-color-instance color)))
		    (mapcar (lambda (arg)
			      (/ arg 256))
			    (x-color-values color)))))
	     (when rgb
	       (setq rgb-string (apply #'format "#%02x%02x%02x" rgb))))))
    ;; If RGB-STRING is still nil, it means the color cannot be found,
    ;; for whatever reason.  In that case just punt and return COLOR.
    ;; Most browsers support a decent set of color names anyway.
    (or rgb-string color)))

;; We store the face properties we care about into an
;; `htmlize-fstruct' type.  That way we only have to analyze face
;; properties, which can be time consuming, once per each face.  The
;; mapping between Emacs faces and htmlize-fstructs is established by
;; htmlize-make-face-map.  The name "fstruct" refers to variables of
;; type `htmlize-fstruct', while the term "face" is reserved for Emacs
;; faces.

(defstruct htmlize-fstruct
  foreground				; foreground color, #rrggbb
  background				; background color, #rrggbb
  size					; size
  boldp					; whether face is bold
  italicp				; whether face is italic
  underlinep				; whether face is underlined
  overlinep				; whether face is overlined
  strikep				; whether face is struck through
  css-name				; CSS name of face
  )

(defun htmlize-face-emacs21-attr (fstruct attr value)
  ;; For ATTR and VALUE, set the equivalent value in FSTRUCT.
  (case attr
    (:foreground
     (setf (htmlize-fstruct-foreground fstruct) (htmlize-color-to-rgb value)))
    (:background
     (setf (htmlize-fstruct-background fstruct) (htmlize-color-to-rgb value)))
    (:height
     (setf (htmlize-fstruct-size fstruct) value))
    (:weight
     (when (string-match (symbol-name value) "bold")
       (setf (htmlize-fstruct-boldp fstruct) t)))
    (:slant
     (setf (htmlize-fstruct-italicp fstruct) (or (eq value 'italic)
						 (eq value 'oblique))))
    (:bold
     (setf (htmlize-fstruct-boldp fstruct) value))
    (:italic
     (setf (htmlize-fstruct-italicp fstruct) value))
    (:underline
     (setf (htmlize-fstruct-underlinep fstruct) value))
    (:overline
     (setf (htmlize-fstruct-overlinep fstruct) value))
    (:strike-through
     (setf (htmlize-fstruct-strikep fstruct) value))))

(defun htmlize-face-size (face)
  ;; The size (height) of FACE, taking inheritance into account.
  ;; Only works in Emacs 21 and later.
  (let ((size-list
	 (loop
	  for f = face then (face-attribute f :inherit)
	  until (or (not f) (eq f 'unspecified))
	  for h = (face-attribute f :height)
	  collect (if (eq h 'unspecified) nil h))))
    (reduce 'htmlize-merge-size (cons nil size-list))))

(defun htmlize-face-to-fstruct (face)
  "Convert Emacs face FACE to fstruct."
  (let ((fstruct (make-htmlize-fstruct
		  :foreground (htmlize-color-to-rgb
			       (htmlize-face-foreground face))
		  :background (htmlize-color-to-rgb
			       (htmlize-face-background face)))))
    (cond (htmlize-running-xemacs
	   ;; XEmacs doesn't provide a way to detect whether a face is
	   ;; bold or italic, so we need to examine the font instance.
	   ;; #### This probably doesn't work under MS Windows and/or
	   ;; GTK devices.  I'll need help with those.
	   (let* ((font-instance (face-font-instance face))
		  (props (font-instance-properties font-instance)))
	     (when (equalp (cdr (assq 'WEIGHT_NAME props)) "bold")
	       (setf (htmlize-fstruct-boldp fstruct) t))
	     (when (or (equalp (cdr (assq 'SLANT props)) "i")
		       (equalp (cdr (assq 'SLANT props)) "o"))
	       (setf (htmlize-fstruct-italicp fstruct) t))
	     (setf (htmlize-fstruct-strikep fstruct)
		   (face-strikethru-p face))
	     (setf (htmlize-fstruct-underlinep fstruct)
		   (face-underline-p face))))
	  ((fboundp 'face-attribute)
	   ;; GNU Emacs 21 and further.
	   (dolist (attr '(:weight :slant :underline :overline :strike-through))
	     (let ((value (if (>= emacs-major-version 22)
			      ;; Use the INHERIT arg in GNU Emacs 22.
			      (face-attribute face attr nil t)
			    ;; Otherwise, fake it.
			    (let ((face face))
			      (while (and (eq (face-attribute face attr)
					      'unspecified)
					  (not (eq (face-attribute face :inherit)
						   'unspecified)))
				(setq face (face-attribute face :inherit)))
			      (face-attribute face attr)))))
	       (when (and value (not (eq value 'unspecified)))
		 (htmlize-face-emacs21-attr fstruct attr value))))
	   (let ((size (htmlize-face-size face)))
	     (unless (eql size 1.0) 	; ignore non-spec
	       (setf (htmlize-fstruct-size fstruct) size))))
	  (t
	   ;; Older GNU Emacs.  Some of these functions are only
	   ;; available under Emacs 20+, hence the guards.
	   (when (fboundp 'face-bold-p)
	     (setf (htmlize-fstruct-boldp fstruct) (face-bold-p face)))
	   (when (fboundp 'face-italic-p)
	     (setf (htmlize-fstruct-italicp fstruct) (face-italic-p face)))
	   (setf (htmlize-fstruct-underlinep fstruct)
		 (face-underline-p face))))
    ;; Generate the css-name property.  Emacs places no restrictions
    ;; on the names of symbols that represent faces -- any characters
    ;; may be in the name, even ^@.  We try hard to beat the face name
    ;; into shape, both esthetically and according to CSS1 specs.
    (setf (htmlize-fstruct-css-name fstruct)
	  (let ((name (downcase (symbol-name face))))
	    (when (string-match "\\`font-lock-" name)
	      ;; Change font-lock-FOO-face to FOO.
	      (setq name (replace-match "" t t name)))
	    (when (string-match "-face\\'" name)
	      ;; Drop the redundant "-face" suffix.
	      (setq name (replace-match "" t t name)))
	    (while (string-match "[^-a-zA-Z0-9]" name)
	      ;; Drop the non-alphanumerics.
	      (setq name (replace-match "X" t t name)))
	    (when (string-match "\\`[-0-9]" name)
	      ;; CSS identifiers may not start with a digit.
	      (setq name (concat "X" name)))
	    ;; After these transformations, the face could come
	    ;; out empty.
	    (when (equal name "")
	      (setq name "face"))
	    ;; Apply the prefix.
	    (setq name (concat htmlize-css-name-prefix name))
	    name))
    fstruct))

(defmacro htmlize-copy-attr-if-set (attr-list dest source)
  ;; Expand the code of the type
  ;; (and (htmlize-fstruct-ATTR source)
  ;;      (setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source)))
  ;; for the given list of boolean attributes.
  (cons 'progn
	(loop for attr in attr-list
	      for attr-sym = (intern (format "htmlize-fstruct-%s" attr))
	      collect `(and (,attr-sym ,source)
			    (setf (,attr-sym ,dest) (,attr-sym ,source))))))

(defun htmlize-merge-size (merged next)
  ;; Calculate the size of the merge of MERGED and NEXT.
  (cond ((null merged)     next)
	((integerp next)   next)
	((null next)       merged)
	((floatp merged)   (* merged next))
	((integerp merged) (round (* merged next)))))

(defun htmlize-merge-two-faces (merged next)
  (htmlize-copy-attr-if-set
   (foreground background boldp italicp underlinep overlinep strikep)
   merged next)
  (setf (htmlize-fstruct-size merged)
	(htmlize-merge-size (htmlize-fstruct-size merged)
			    (htmlize-fstruct-size next)))
  merged)

(defun htmlize-merge-faces (fstruct-list)
  (cond ((null fstruct-list)
	 ;; Nothing to do, return a dummy face.
	 (make-htmlize-fstruct))
	((null (cdr fstruct-list))
	 ;; Optimize for the common case of a single face, simply
	 ;; return it.
	 (car fstruct-list))
	(t
	 (reduce #'htmlize-merge-two-faces
		 (cons (make-htmlize-fstruct) fstruct-list)))))

;; GNU Emacs 20+ supports attribute lists in `face' properties.  For
;; example, you can use `(:foreground "red" :weight bold)' as an
;; overlay's "face", or you can even use a list of such lists, etc.
;; We call those "attrlists".
;;
;; htmlize supports attrlist by converting them to fstructs, the same
;; as with regular faces.

(defun htmlize-attrlist-to-fstruct (attrlist)
  ;; Like htmlize-face-to-fstruct, but accepts an ATTRLIST as input.
  (let ((fstruct (make-htmlize-fstruct)))
    (cond ((eq (car attrlist) 'foreground-color)
	   ;; ATTRLIST is (foreground-color . COLOR)
	   (setf (htmlize-fstruct-foreground fstruct)
		 (htmlize-color-to-rgb (cdr attrlist))))
	  ((eq (car attrlist) 'background-color)
	   ;; ATTRLIST is (background-color . COLOR)
	   (setf (htmlize-fstruct-background fstruct)
		 (htmlize-color-to-rgb (cdr attrlist))))
	  (t
	   ;; ATTRLIST is a plist.
	   (while attrlist
	     (let ((attr (pop attrlist))
		   (value (pop attrlist)))
	       (when (and value (not (eq value 'unspecified)))
		 (htmlize-face-emacs21-attr fstruct attr value))))))
    (setf (htmlize-fstruct-css-name fstruct) "ATTRLIST")
    fstruct))

(defun htmlize-face-list-p (face-prop)
  "Return non-nil if FACE-PROP is a list of faces, nil otherwise."
  ;; If not for attrlists, this would return (listp face-prop).  This
  ;; way we have to be more careful because attrlist is also a list!
  (cond
   ((eq face-prop nil)
    ;; FACE-PROP being nil means empty list (no face), so return t.
    t)
   ((symbolp face-prop)
    ;; A symbol other than nil means that it's only one face, so return
    ;; nil.
    nil)
   ((not (consp face-prop))
    ;; Huh?  Not a symbol or cons -- treat it as a single element.
    nil)
   (t
    ;; We know that FACE-PROP is a cons: check whether it looks like an
    ;; ATTRLIST.
    (let* ((car (car face-prop))
	   (attrlist-p (and (symbolp car)
			    (or (eq car 'foreground-color)
				(eq car 'background-color)
				(eq (aref (symbol-name car) 0) ?:)))))
      ;; If FACE-PROP is not an ATTRLIST, it means it's a list of
      ;; faces.
      (not attrlist-p)))))

(defun htmlize-make-face-map (faces)
  ;; Return a hash table mapping Emacs faces to htmlize's fstructs.
  ;; The keys are either face symbols or attrlists, so the test
  ;; function must be `equal'.
  (let ((face-map (make-hash-table :test 'equal))
	css-names)
    (dolist (face faces)
      (unless (gethash face face-map)
	;; Haven't seen FACE yet; convert it to an fstruct and cache
	;; it.
	(let ((fstruct (if (symbolp face)
			   (htmlize-face-to-fstruct face)
			 (htmlize-attrlist-to-fstruct face))))
	  (setf (gethash face face-map) fstruct)
	  (let* ((css-name (htmlize-fstruct-css-name fstruct))
		 (new-name css-name)
		 (i 0))
	    ;; Uniquify the face's css-name by using NAME-1, NAME-2,
	    ;; etc.
	    (while (member new-name css-names)
	      (setq new-name (format "%s-%s" css-name (incf i))))
	    (unless (equal new-name css-name)
	      (setf (htmlize-fstruct-css-name fstruct) new-name))
	    (push new-name css-names)))))
    face-map))

(defun htmlize-unstringify-face (face)
  "If FACE is a string, return it interned, otherwise return it unchanged."
  (if (stringp face)
      (intern face)
    face))

(defun htmlize-faces-in-buffer ()
  "Return a list of faces used in the current buffer.
Under XEmacs, this returns the set of faces specified by the extents
with the `face' property.  (This covers text properties as well.)  Under
GNU Emacs, it returns the set of faces specified by the `face' text
property and by buffer overlays that specify `face'."
  (let (faces)
    ;; Testing for (fboundp 'map-extents) doesn't work because W3
    ;; defines `map-extents' under FSF.
    (if htmlize-running-xemacs
	(let (face-prop)
	  (map-extents (lambda (extent ignored)
			 (setq face-prop (extent-face extent)
			       ;; FACE-PROP can be a face or a list of
			       ;; faces.
			       faces (if (listp face-prop)
					 (union face-prop faces)
				       (adjoin face-prop faces)))
			 nil)
		       nil
		       ;; Specify endpoints explicitly to respect
		       ;; narrowing.
		       (point-min) (point-max) nil nil 'face))
      ;; FSF Emacs code.
      ;; Faces used by text properties.
      (let ((pos (point-min)) face-prop next)
	(while (< pos (point-max))
	  (setq face-prop (get-text-property pos 'face)
		next (or (next-single-property-change pos 'face) (point-max)))
	  ;; FACE-PROP can be a face/attrlist or a list thereof.
	  (setq faces (if (htmlize-face-list-p face-prop)
			  (nunion (mapcar #'htmlize-unstringify-face face-prop)
				  faces :test 'equal)
			(adjoin (htmlize-unstringify-face face-prop)
				faces :test 'equal)))
	  (setq pos next)))
      ;; Faces used by overlays.
      (dolist (overlay (overlays-in (point-min) (point-max)))
	(let ((face-prop (overlay-get overlay 'face)))
	  ;; FACE-PROP can be a face/attrlist or a list thereof.
	  (setq faces (if (htmlize-face-list-p face-prop)
			  (nunion (mapcar #'htmlize-unstringify-face face-prop)
				  faces :test 'equal)
			(adjoin (htmlize-unstringify-face face-prop)
				faces :test 'equal))))))
    faces))

;; htmlize-faces-at-point returns the faces in use at point.  The
;; faces are sorted by increasing priority, i.e. the last face takes
;; precedence.
;;
;; Under XEmacs, this returns all the faces in all the extents at
;; point.  Under GNU Emacs, this returns all the faces in the `face'
;; property and all the faces in the overlays at point.

(cond (htmlize-running-xemacs
       (defun htmlize-faces-at-point ()
	 (let (extent extent-list face-list face-prop)
	   (while (setq extent (extent-at (point) nil 'face extent))
	     (push extent extent-list))
	   ;; extent-list is in reverse display order, meaning that
	   ;; smallest ones come last.  That is the order we want,
	   ;; except it can be overridden by the `priority' property.
	   (setq extent-list (stable-sort extent-list #'<
					  :key #'extent-priority))
	   (dolist (extent extent-list)
	     (setq face-prop (extent-face extent))
	     ;; extent's face-list is in reverse order from what we
	     ;; want, but the `nreverse' below will take care of it.
	     (setq face-list (if (listp face-prop)
				 (append face-prop face-list)
			       (cons face-prop face-list))))
	   (nreverse face-list))))
      (t
       (defun htmlize-faces-at-point ()
	 (let (all-faces)
	   ;; Faces from text properties.
	   (let ((face-prop (get-text-property (point) 'face)))
	     (setq all-faces (if (htmlize-face-list-p face-prop)
				 (nreverse (mapcar #'htmlize-unstringify-face
						   face-prop))
			       (list (htmlize-unstringify-face face-prop)))))
	   ;; Faces from overlays.
	   (let ((overlays
		  ;; Collect overlays at point that specify `face'.
		  (delete-if-not (lambda (o)
				   (overlay-get o 'face))
				 (overlays-at (point))))
		 list face-prop)
	     ;; Sort the overlays so the smaller (more specific) ones
	     ;; come later.  The number of overlays at each one
	     ;; position should be very small, so the sort shouldn't
	     ;; slow things down.
	     (setq overlays (sort* overlays
				   ;; Sort by ascending...
				   #'<
				   ;; ...overlay size.
				   :key (lambda (o)
					  (- (overlay-end o)
					     (overlay-start o)))))
	     ;; Overlay priorities, if present, override the above
	     ;; established order.  Larger overlay priority takes
	     ;; precedence and therefore comes later in the list.
	     (setq overlays (stable-sort
			     overlays
			     ;; Reorder (stably) by acending...
			     #'<
			     ;; ...overlay priority.
			     :key (lambda (o)
				    (or (overlay-get o 'priority) 0))))
	     (dolist (overlay overlays)
	       (setq face-prop (overlay-get overlay 'face))
	       (setq list (if (htmlize-face-list-p face-prop)
			      (nconc (nreverse (mapcar
						#'htmlize-unstringify-face
						face-prop))
				     list)
			    (cons (htmlize-unstringify-face face-prop) list))))
	     ;; Under "Merging Faces" the manual explicitly states
	     ;; that faces specified by overlays take precedence over
	     ;; faces specified by text properties.
	     (setq all-faces (nconc all-faces list)))
	   all-faces))))

;; htmlize supports generating HTML in two several fundamentally
;; different ways, one with the use of CSS and nested  tags, and
;; the other with the use of the old  tags.  Rather than adding
;; a bunch of ifs to many places, we take a semi-OO approach.
;; `htmlize-buffer-1' calls a number of "methods", which indirect to
;; the functions that depend on `htmlize-output-type'.  The currently
;; used methods are `doctype', `insert-head', `body-tag', and
;; `insert-text'.  Not all output types define all methods.
;;
;; Methods are called either with (htmlize-method METHOD ARGS...) 
;; special form, or by accessing the function with
;; (htmlize-method-function 'METHOD) and calling (funcall FUNCTION).
;; The latter form is useful in tight loops because `htmlize-method'
;; conses.
;;
;; Currently defined output types are `css' and `font'.

(defmacro htmlize-method (method &rest args)
  ;; Expand to (htmlize-TYPE-METHOD ...ARGS...).  TYPE is the value of
  ;; `htmlize-output-type' at run time.
  `(funcall (htmlize-method-function ',method) ,@args))

(defun htmlize-method-function (method)
  ;; Return METHOD's function definition for the current output type.
  ;; The returned object can be safely funcalled.
  (let ((sym (intern (format "htmlize-%s-%s" htmlize-output-type method))))
    (indirect-function (if (fboundp sym)
			   sym
			 (let ((default (intern (concat "htmlize-default-"
							(symbol-name method)))))
			   (if (fboundp default)
			       default
			     'ignore))))))

(defvar htmlize-memoization-table (make-hash-table :test 'equal))

(defmacro htmlize-memoize (key generator)
  "Return the value of GENERATOR, memoized as KEY.
That means that GENERATOR will be evaluated and returned the first time
it's called with the same value of KEY.  All other times, the cached
\(memoized) value will be returned."
  (let ((value (gensym)))
    `(let ((,value (gethash ,key htmlize-memoization-table)))
       (unless ,value
	 (setq ,value ,generator)
	 (setf (gethash ,key htmlize-memoization-table) ,value))
       ,value)))

;;; Default methods.

(defun htmlize-default-doctype ()
  nil					; no doc-string
  ;; According to DTDs published by the W3C, it is illegal to embed
  ;;  in 
.  This makes sense in general, but is bad for
  ;; htmlize's intended usage of  to specify the document color.

  ;; To make generated HTML legal, htmlize's `font' mode used to
  ;; specify the SGML declaration of "HTML Pro" DTD here.  HTML Pro
  ;; aka Silmaril DTD was a project whose goal was to produce a GPL'ed
  ;; DTD that would encompass all the incompatible HTML extensions
  ;; procured by Netscape, MSIE, and other players in the field.
  ;; Apparently the project got abandoned, the last available version
  ;; being "Draft 0 Revision 11" from January 1997, as documented at
  ;; .

  ;; Since by now HTML Pro is remembered by none but the most die-hard
  ;; early-web-days nostalgics and used by not even them, there is no
  ;; use in specifying it.  So we return the standard HTML 4.0
  ;; declaration, which makes generated HTML technically illegal.  If
  ;; you have a problem with that, use the `css' engine designed to
  ;; create fully conforming HTML.

  ""

  ;; Now-abandoned HTML Pro declaration.
  ;""
  )

(defun htmlize-default-body-tag (face-map)
  nil					; no doc-string
  "")

;;; CSS based output support.

;; Internal function; not a method.
(defun htmlize-css-specs (fstruct)
  (let (result)
    (when (htmlize-fstruct-foreground fstruct)
      (push (format "color: %s;" (htmlize-fstruct-foreground fstruct))
	    result))
    (when (htmlize-fstruct-background fstruct)
      (push (format "background-color: %s;"
		    (htmlize-fstruct-background fstruct))
	    result))
    (let ((size (htmlize-fstruct-size fstruct)))
      (when (and size (not (eq htmlize-ignore-face-size t)))
	(cond ((floatp size)
	       (push (format "font-size: %d%%;" (* 100 size)) result))
	      ((not (eq htmlize-ignore-face-size 'absolute))
	       (push (format "font-size: %spt;" (/ size 10.0)) result)))))
    (when (htmlize-fstruct-boldp fstruct)
      (push "font-weight: bold;" result))
    (when (htmlize-fstruct-italicp fstruct)
      (push "font-style: italic;" result))
    (when (htmlize-fstruct-underlinep fstruct)
      (push "text-decoration: underline;" result))
    (when (htmlize-fstruct-overlinep fstruct)
      (push "text-decoration: overline;" result))
    (when (htmlize-fstruct-strikep fstruct)
      (push "text-decoration: line-through;" result))
    (nreverse result)))

(defun htmlize-css-insert-head (buffer-faces face-map)
  (insert "    \n"))

(defun htmlize-css-insert-text (text fstruct-list buffer)
  ;; Insert TEXT colored with FACES into BUFFER.  In CSS mode, this is
  ;; easy: just nest the text in one  tag for each
  ;; face in FSTRUCT-LIST.
  (dolist (fstruct fstruct-list)
    (princ "" buffer))
  (princ text buffer)
  (dolist (fstruct fstruct-list)
    (ignore fstruct)			; shut up the byte-compiler
    (princ "" buffer)))

;; `inline-css' output support.

(defun htmlize-inline-css-body-tag (face-map)
  (format ""
	  (mapconcat #'identity (htmlize-css-specs (gethash 'default face-map))
		     " ")))

(defun htmlize-inline-css-insert-text (text fstruct-list buffer)
  (let* ((merged (htmlize-merge-faces fstruct-list))
	 (style (htmlize-memoize
		 merged
		 (let ((specs (htmlize-css-specs merged)))
		   (and specs
			(mapconcat #'identity (htmlize-css-specs merged) " "))))))
    (when style
      (princ "" buffer))
    (princ text buffer)
    (when style
      (princ "" buffer))))

;;; `font' tag based output support.

(defun htmlize-font-body-tag (face-map)
  (let ((fstruct (gethash 'default face-map)))
    (format ""
	    (htmlize-fstruct-foreground fstruct)
	    (htmlize-fstruct-background fstruct))))
       
(defun htmlize-font-insert-text (text fstruct-list buffer)
  ;; In `font' mode, we use the traditional HTML means of altering
  ;; presentation:  tag for colors,  for bold,  for
  ;; underline, and  for strike-through.
  (let* ((merged (htmlize-merge-faces fstruct-list))
	 (markup (htmlize-memoize
		  merged
		  (cons (concat
			 (and (htmlize-fstruct-foreground merged)
			      (format "" (htmlize-fstruct-foreground merged)))
			 (and (htmlize-fstruct-boldp merged)      "")
			 (and (htmlize-fstruct-italicp merged)    "")
			 (and (htmlize-fstruct-underlinep merged) "")
			 (and (htmlize-fstruct-strikep merged)    ""))
			(concat
			 (and (htmlize-fstruct-strikep merged)    "")
			 (and (htmlize-fstruct-underlinep merged) "")
			 (and (htmlize-fstruct-italicp merged)    "")
			 (and (htmlize-fstruct-boldp merged)      "")
			 (and (htmlize-fstruct-foreground merged) ""))))))
    (princ (car markup) buffer)
    (princ text buffer)
    (princ (cdr markup) buffer)))

(defun htmlize-buffer-1 ()
  ;; Internal function; don't call it from outside this file.  Htmlize
  ;; current buffer, writing the resulting HTML to a new buffer, and
  ;; return it.  Unlike htmlize-buffer, this doesn't change current
  ;; buffer or use switch-to-buffer.
  (save-excursion
    ;; Protect against the hook changing the current buffer.
    (save-excursion
      (run-hooks 'htmlize-before-hook))
    ;; Convince font-lock support modes to fontify the entire buffer
    ;; in advance.
    (htmlize-ensure-fontified)
    (clrhash htmlize-extended-character-cache)
    (clrhash htmlize-memoization-table)
    (let* ((buffer-faces (htmlize-faces-in-buffer))
	   (face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
	   ;; Generate the new buffer.  It's important that it inherits
	   ;; default-directory from the current buffer.
	   (htmlbuf (generate-new-buffer (if (buffer-file-name)
					     (htmlize-make-file-name
					      (file-name-nondirectory
					       (buffer-file-name)))
					   "*html*")))
	   ;; Having a dummy value in the plist allows writing simply
	   ;; (plist-put places foo bar).
	   (places '(nil nil))
	   (title (if (buffer-file-name)
		      (file-name-nondirectory (buffer-file-name))
		    (buffer-name))))
      ;; Initialize HTMLBUF and insert the HTML prolog.
      (with-current-buffer htmlbuf
	(buffer-disable-undo)
	(insert (htmlize-method doctype) ?\n
		(format "\n"
			htmlize-version htmlize-output-type)
		"\n  ")
	(plist-put places 'head-start (point-marker))
	(insert "\n"
		"    " (htmlize-protect-string title) "\n"
		(if htmlize-html-charset
		    (format (concat "    \n")
			    htmlize-html-charset)
		  "")
		htmlize-head-tags)
	(htmlize-method insert-head buffer-faces face-map)
	(insert "  ")
	(plist-put places 'head-end (point-marker))
	(insert "\n  ")
	(plist-put places 'body-start (point-marker))
	(insert (htmlize-method body-tag face-map)
		"\n    ")
	(plist-put places 'content-start (point-marker))
	(insert "
\n"))
      (let ((insert-text-method
	     ;; Get the inserter method, so we can funcall it inside
	     ;; the loop.  Not calling `htmlize-method' in the loop
	     ;; body yields a measurable speed increase.
	     (htmlize-method-function 'insert-text))
	    ;; Declare variables used in loop body outside the loop
	    ;; because it's faster to establish `let' bindings only
	    ;; once.
	    next-change text face-list fstruct-list trailing-ellipsis)
	;; This loop traverses and reads the source buffer, appending
	;; the resulting HTML to HTMLBUF with `princ'.  This method is
	;; fast because: 1) it doesn't require examining the text
	;; properties char by char (htmlize-next-change is used to
	;; move between runs with the same face), and 2) it doesn't
	;; require buffer switches, which are slow in Emacs.
	(goto-char (point-min))
	(while (not (eobp))
	  (setq next-change (htmlize-next-change (point) 'face))
	  ;; Get faces in use between (point) and NEXT-CHANGE, and
	  ;; convert them to fstructs.
	  (setq face-list (htmlize-faces-at-point)
		fstruct-list (delq nil (mapcar (lambda (f)
						 (gethash f face-map))
					       face-list)))
	  ;; Extract buffer text, sans the invisible parts.  Then
	  ;; untabify it and escape the HTML metacharacters.
	  (setq text (htmlize-buffer-substring-no-invisible
		      (point) next-change))
	  (when trailing-ellipsis
	    (setq text (htmlize-trim-ellipsis text)))
	  ;; If TEXT ends up empty, don't change trailing-ellipsis.
	  (when (> (length text) 0)
	    (setq trailing-ellipsis
		  (get-text-property (1- (length text))
				     'htmlize-ellipsis text)))
	  (setq text (htmlize-untabify text (current-column)))
	  (setq text (htmlize-protect-string text))
	  ;; Don't bother writing anything if there's no text (this
	  ;; happens in invisible regions).
	  (when (> (length text) 0)
	    ;; Insert the text, along with the necessary markup to
	    ;; represent faces in FSTRUCT-LIST.
	    (funcall insert-text-method text fstruct-list htmlbuf))
	  (goto-char next-change)))

      ;; Insert the epilog and post-process the buffer.
      (with-current-buffer htmlbuf
	(insert "
")
	(plist-put places 'content-end (point-marker))
	(insert "\n  ")
	(plist-put places 'body-end (point-marker))
	(insert "\n\n")
	(when htmlize-generate-hyperlinks
	  (htmlize-make-hyperlinks))
	(htmlize-defang-local-variables)
	(when htmlize-replace-form-feeds
	  ;; Change each "\n^L" to "
".
	  (goto-char (point-min))
	  (let ((source
		 ;; ^L has already been escaped, so search for that.
		 (htmlize-protect-string "\n\^L"))
		(replacement
		 (if (stringp htmlize-replace-form-feeds)
		     htmlize-replace-form-feeds
		   "
")))
	    (while (search-forward source nil t)
	      (replace-match replacement t t))))
	(goto-char (point-min))
	(when htmlize-html-major-mode
	  ;; What sucks about this is that the minor modes, most notably
	  ;; font-lock-mode, won't be initialized.  Oh well.
	  (funcall htmlize-html-major-mode))
	(set (make-local-variable 'htmlize-buffer-places) places)
	(run-hooks 'htmlize-after-hook)
	(buffer-enable-undo))
      htmlbuf)))

;; Utility functions.

(defmacro htmlize-with-fontify-message (&rest body)
  ;; When forcing fontification of large buffers in
  ;; htmlize-ensure-fontified, inform the user that he is waiting for
  ;; font-lock, not for htmlize to finish.
  `(progn
     (if (> (buffer-size) 65536)
	 (message "Forcing fontification of %s..."
		  (buffer-name (current-buffer))))
     ,@body
     (if (> (buffer-size) 65536)
	 (message "Forcing fontification of %s...done"
		  (buffer-name (current-buffer))))))

(defun htmlize-ensure-fontified ()
  ;; If font-lock is being used, ensure that the "support" modes
  ;; actually fontify the buffer.  If font-lock is not in use, we
  ;; don't care because, except in htmlize-file, we don't force
  ;; font-lock on the user.
  (when (and (boundp 'font-lock-mode)
	     font-lock-mode)
    ;; In part taken from ps-print-ensure-fontified in GNU Emacs 21.
    (cond
     ((and (boundp 'jit-lock-mode)
	   (symbol-value 'jit-lock-mode))
      (htmlize-with-fontify-message
       (jit-lock-fontify-now (point-min) (point-max))))
     ((and (boundp 'lazy-lock-mode)
	   (symbol-value 'lazy-lock-mode))
      (htmlize-with-fontify-message
       (lazy-lock-fontify-region (point-min) (point-max))))
     ((and (boundp 'lazy-shot-mode)
	   (symbol-value 'lazy-shot-mode))
      (htmlize-with-fontify-message
       ;; lazy-shot is amazing in that it must *refontify* the region,
       ;; even if the whole buffer has already been fontified.  
       (lazy-shot-fontify-region (point-min) (point-max))))
     ;; There's also fast-lock, but we don't need to handle specially,
     ;; I think.  fast-lock doesn't really defer fontification, it
     ;; just saves it to an external cache so it's not done twice.
     )))


;;;###autoload
(defun htmlize-buffer (&optional buffer)
  "Convert BUFFER to HTML, preserving colors and decorations.

The generated HTML is available in a new buffer, which is returned.
When invoked interactively, the new buffer is selected in the current
window.  The title of the generated document will be set to the buffer's
file name or, if that's not available, to the buffer's name.

Note that htmlize doesn't fontify your buffers, it only uses the
decorations that are already present.  If you don't set up font-lock or
something else to fontify your buffers, the resulting HTML will be
plain.  Likewise, if you don't like the choice of colors, fix the mode
that created them, or simply alter the faces it uses."
  (interactive)
  (let ((htmlbuf (with-current-buffer (or buffer (current-buffer))
		   (htmlize-buffer-1))))
    (when (interactive-p)
      (switch-to-buffer htmlbuf))
    htmlbuf))

;;;###autoload
(defun htmlize-region (beg end)
  "Convert the region to HTML, preserving colors and decorations.
See `htmlize-buffer' for details."
  (interactive "r")
  ;; Don't let zmacs region highlighting end up in HTML.
  (when (fboundp 'zmacs-deactivate-region)
    (zmacs-deactivate-region))
  (let ((htmlbuf (save-restriction
		   (narrow-to-region beg end)
		   (htmlize-buffer-1))))
    (when (interactive-p)
      (switch-to-buffer htmlbuf))
    htmlbuf))

(defun htmlize-region-for-paste (beg end)
  "Htmlize the region and return just the HTML as a string.
This forces the `inline-css' style and only returns the HTML body,
but without the BODY tag.  This should make it useful for inserting
the text to another HTML buffer."
  (let* ((htmlize-output-type 'inline-css)
	 (htmlbuf (htmlize-region beg end)))
    (unwind-protect
	(with-current-buffer htmlbuf
	  (buffer-substring (plist-get htmlize-buffer-places 'content-start)
			    (plist-get htmlize-buffer-places 'content-end)))
      (kill-buffer htmlbuf))))

(defun htmlize-make-file-name (file)
  "Make an HTML file name from FILE.

In its default implementation, this simply appends `.html' to FILE.
This function is called by htmlize to create the buffer file name, and
by `htmlize-file' to create the target file name.

More elaborate transformations are conceivable, such as changing FILE's
extension to `.html' (\"file.c\" -> \"file.html\").  If you want them,
overload this function to do it and htmlize will comply."
  (concat file ".html"))

;; Older implementation of htmlize-make-file-name that changes FILE's
;; extension to ".html".
;(defun htmlize-make-file-name (file)
;  (let ((extension (file-name-extension file))
;	(sans-extension (file-name-sans-extension file)))
;    (if (or (equal extension "html")
;	    (equal extension "htm")
;	    (equal sans-extension ""))
;	(concat file ".html")
;      (concat sans-extension ".html"))))

;;;###autoload
(defun htmlize-file (file &optional target)
  "Load FILE, fontify it, convert it to HTML, and save the result.

Contents of FILE are inserted into a temporary buffer, whose major mode
is set with `normal-mode' as appropriate for the file type.  The buffer
is subsequently fontified with `font-lock' and converted to HTML.  Note
that, unlike `htmlize-buffer', this function explicitly turns on
font-lock.  If a form of highlighting other than font-lock is desired,
please use `htmlize-buffer' directly on buffers so highlighted.

Buffers currently visiting FILE are unaffected by this function.  The
function does not change current buffer or move the point.

If TARGET is specified and names a directory, the resulting file will be
saved there instead of to FILE's directory.  If TARGET is specified and
does not name a directory, it will be used as output file name."
  (interactive (list (read-file-name
		      "HTML-ize file: "
		      nil nil nil (and (buffer-file-name)
				       (file-name-nondirectory
					(buffer-file-name))))))
  (let ((output-file (if (and target (not (file-directory-p target)))
			 target
		       (expand-file-name
			(htmlize-make-file-name (file-name-nondirectory file))
			(or target (file-name-directory file)))))
	;; Try to prevent `find-file-noselect' from triggering
	;; font-lock because we'll fontify explicitly below.
	(font-lock-mode nil)
	(font-lock-auto-fontify nil)
	(global-font-lock-mode nil)
	;; Ignore the size limit for the purposes of htmlization.
	(font-lock-maximum-size nil)
	;; Disable font-lock support modes.  This will only work in
	;; more recent Emacs versions, so htmlize-buffer-1 still needs
	;; to call htmlize-ensure-fontified.
	(font-lock-support-mode nil))
    (with-temp-buffer
      ;; Insert FILE into the temporary buffer.
      (insert-file-contents file)
      ;; Set the file name so normal-mode and htmlize-buffer-1 pick it
      ;; up.  Restore it afterwards so with-temp-buffer's kill-buffer
      ;; doesn't complain about killing a modified buffer.
      (let ((buffer-file-name file))
	;; Set the major mode for the sake of font-lock.
	(normal-mode)
	(font-lock-mode 1)
	(unless font-lock-mode
	  ;; In GNU Emacs (font-lock-mode 1) doesn't force font-lock,
	  ;; contrary to the documentation.  This seems to work.
	  (font-lock-fontify-buffer))
	;; htmlize the buffer and save the HTML.
	(with-current-buffer (htmlize-buffer-1)
	  (unwind-protect
	      (progn
		(run-hooks 'htmlize-file-hook)
		(write-region (point-min) (point-max) output-file))
	    (kill-buffer (current-buffer)))))))
  ;; I haven't decided on a useful return value yet, so just return
  ;; nil.
  nil)

;;;###autoload
(defun htmlize-many-files (files &optional target-directory)
  "Convert FILES to HTML and save the corresponding HTML versions.

FILES should be a list of file names to convert.  This function calls
`htmlize-file' on each file; see that function for details.  When
invoked interactively, you are prompted for a list of files to convert,
terminated with RET.

If TARGET-DIRECTORY is specified, the HTML files will be saved to that
directory.  Normally, each HTML file is saved to the directory of the
corresponding source file."
  (interactive
   (list
    (let (list file)
      ;; Use empty string as DEFAULT because setting DEFAULT to nil
      ;; defaults to the directory name, which is not what we want.
      (while (not (equal (setq file (read-file-name
				     "HTML-ize file (RET to finish): "
				     (and list (file-name-directory
						(car list)))
				     "" t))
			 ""))
	(push file list))
      (nreverse list))))
  ;; Verify that TARGET-DIRECTORY is indeed a directory.  If it's a
  ;; file, htmlize-file will use it as target, and that doesn't make
  ;; sense.
  (and target-directory
       (not (file-directory-p target-directory))
       (error "target-directory must name a directory: %s" target-directory))
  (dolist (file files)
    (htmlize-file file target-directory)))

;;;###autoload
(defun htmlize-many-files-dired (arg &optional target-directory)
  "HTMLize dired-marked files."
  (interactive "P")
  (htmlize-many-files (dired-get-marked-files nil arg) target-directory))

(provide 'htmlize)

;;; htmlize.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/tlc.el0000775000000000000000000002345612230377265020364 0ustar  ;;; tlc --- Major mode for editing tlc files
;;
;; Author: Eric M. Ludlam 
;; Keywords: tlc
;; Version: $Revision: 1.2 $
;; X-RCS: $Id: tlc.el,v 1.2 2013-01-25 18:45:28 psg Exp $
;; X-Abstract: Major mode for editing tlc files
;;
;; Copyright (c) 1997, 1998 by The MathWorks, Inc.
;;
;; This program is derived from 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 2, 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;;; Commentary:
;;
;;  This is a major mode for editing Target Language Compiler scripts.
;;  It automatically indents the programming constructs.
;;
;;  To use this mode, put the this file into your load path, and add
;;  the following to your .emacs file:
;;
;;    (require 'tlc)
;;  or
;;    (autoload 'tlc-mode "tlc" "tlc Editing Mode" t)
;;    (add-to-list 'auto-mode-alist '("\\.tlc$" . tlc-mode))
;;
;;; History:
;;
;;  10Sep1998 by Eric M.  Ludlam 
;;    Posted First revision onto the FTP site.
;;
;;  06Oct2005 Peter S galbraith 
;;    Minor changes for:
;;    - support customization.
;;    - added autoload cookies.
;;    - CVS storage elsewhere without changing the version number.

;;; Code:
(defvar tlc-version "Revision: 1.12"
  "The current version of TLC mode.")

(defun tlc-version ()
  "Display the current version of TLC mode."
  (interactive)
  (message tlc-version))

(defgroup tlc nil
  "Major mode for editing tlc files."
  :group 'languages)

(defvar tlc-syntax-table nil
  "Syntax table used in an TLC file.")

(unless tlc-syntax-table
  (setq tlc-syntax-table (make-syntax-table (standard-syntax-table)))
  (modify-syntax-entry ?/  ". 14" tlc-syntax-table)
  (modify-syntax-entry ?%  ". 2356" tlc-syntax-table)
  (modify-syntax-entry ?\n "> b" tlc-syntax-table)
  (modify-syntax-entry ?\" "\"" tlc-syntax-table)
  (modify-syntax-entry ?< "(>" tlc-syntax-table)
  (modify-syntax-entry ?> ")>" tlc-syntax-table))

(defvar tlc-mode-map
  (let ((km  (make-sparse-keymap)))
    (define-key km "\C-m" 'tlc-return)
    (define-key km [return] 'tlc-return)
    (define-key km "\C-i" 'tlc-indent)
    km)
  "Keymap for `tlc-mode'.")

(defvar tlc-font-lock-output-code 'tlc-font-lock-output-code
  "Face for output code.")

(defface tlc-font-lock-output-code
  '((((class grayscale) (background light))
     (:foreground "DimGray" :underline t))
    (((class grayscale) (background dark))
     (:foreground "LightGray" :underline t))
    (((class color) (background light)) (:foreground "DarkGreen"))
    (((class color) (background dark))  (:foreground "chartreuse"))
    (t (:underline t)))
  "Font Lock mode face used to highlight tlc keywords."
  :group 'tlc)

(defcustom tlc-keywords
  '("CAST" "EXISTS" "FEVAL" "FILE_EXISTS" "FORMAT"
    "FIELDNAMES" "GETFIELD" "GENERATE"
    "GENERATE_FILENAME" "GENERATE_FORMATTED_VALUE"
    "GENERATE_FUNCTION_EXISTS" "GENERATE_TYPE"
    "GENERATE_TYPE_FUNCTION_EXISTS" "GET_COMMAND_SWITCH"
    "IDNUM" "IMAG"
    "INT8MAX" "INT8MIN"
    "INT16MAX" "INT16MIN"
    "INT32MAX" "INT32MIN"
    "ISEQUAL" "ISFIELD" "ISINF" "ISNAN" "ISFINITE"
    "NULL_FILE" "NUMTLCFILES"
    "OUTPUT_LINES" "SIZE" "STDOUT" "STRING" "STRINGOF"
    "SYSNAME" "TLCFILES" "TLC_TIME"
    "TLC_FALSE" "TLC_TRUE"
    "TLC_VERSION" "TYPE"
    "UINT8MAX" "UINT16MAX" "UINT32MAX"
    "UINTWHITE_SPACE" "WILL_ROLL")
  "Keywords to highlight in TLC."
  :type '(repeat (string :tag "keyword"))
  :group 'tlc)

(defvar tlc-font-lock-keywords
  (list
   ;; Some keywords
   '("^%function\\s-+\\(\\sw+\\)\\s-*(" 1 font-lock-function-name-face)
   '("^%function\\s-+\\(\\sw+\\)\\s-*("
     ("\\s-*\\(\\sw+\\)\\s-*[,)]" nil nil
      (1 font-lock-variable-name-face)))
   '("\\(%%[^\n]*\\)\n" 1 font-lock-comment-face prepend)
   '("\\(^[ \t]*\\([^ \n\t%]\\|%<\\)[^\n]*\\)$" 1 tlc-font-lock-output-code append)
   '("\\(^\\|\\s-\\)\\(%[^% \t(\n>]+\\)\\>" 2 font-lock-keyword-face)
   '("%assign\\s-+:*\\([_a-zA-Z0-9.]+\\)\\s-*\\($\\|=\\)" 1 font-lock-variable-name-face)
   '("%\\(exit\\|warning\\|error\\|trace\\) \\([^\n]+\\)$" 2 font-lock-string-face prepend)
   '("\\(%<[^%\n>]+>\\)" 1 font-lock-reference-face prepend)
   (list (concat "\\<\\(" (regexp-opt tlc-keywords) "\\)\\>")
	 1 'font-lock-type-face)
   '("[^.]\\(\\.\\.\\.\\)$" 1 'underline prepend)
   )
  "List of keywords for nicely coloring X defaults.")

;;;###autoload
(defun tlc-mode ()
  "Major mode for editing Tlc files, or files found in tlc directories."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'tlc-mode)
  (setq mode-name "TLC")
  (use-local-map tlc-mode-map)
  (set-syntax-table tlc-syntax-table)
  (make-variable-buffer-local 'comment-start-skip)
  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'comment-column)
  (make-local-variable 'comment-start-skip)
  (make-local-variable 'comment-multi-line)
  (setq comment-start "/% "
	comment-end   " %/"
	comment-multi-line t)
  (setq comment-start-skip "%%\\|/%")
  (make-variable-buffer-local 'font-lock-comment-start-regexp)
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'tlc-indent)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '((tlc-font-lock-keywords
			      )
			     nil ; do not do string/comment highlighting
			     nil ; keywords are case sensitive.
			     ;; This puts _ as a word constituant,
			     ;; simplifying our keywords significantly
			     ((?_ . "w"))))
  (tlc-version))

(defun tlc-return ()
  "Handle carriage return in `tlc-mode'."
  (interactive)
  (newline)
  (tlc-indent))

(defun tlc-indent ()
  "Indent the current line to the indentation of the previous line."
  (interactive)
  (beginning-of-line)
  (delete-horizontal-space)
  (indent-to (tlc-calc-indentation)))

(defun tlc-calc-indentation ()
  "Calculate the indentation of this line."
  (beginning-of-line)
  (let ((i (cond
	    ((looking-at
	      "\\s-*\\(\\(\\(%end\\(roll\\|with\\|if\\|for\\|\
foreach\\|while\\|function\\)\\|%else\\|%elseif\\|%case\\|%default\\)\\>\\)\
\\|}\\)")
	     -2)
	    ((looking-at "\\s-*%/")
	     -1)
	    ((looking-at "\\s-*%endswitch")
	     -4)
	    (t 0)))
	(percent (looking-at "\\s-*%"))
	(percent-slash (looking-at "\\s-*%/"))
	(percent-percent (looking-at "\\s-*%%"))
	(indent-because-of-continuation nil))

    (if (bobp) (current-indentation)
      (save-excursion
	(forward-line -1)
	(beginning-of-line)
	(while (and (looking-at "^\\s-*$") (not (bobp))) (forward-line -1))
	(cond ((bobp) nil)
	      ((and percent (looking-at "\\s-*/%"))
	       (setq i (+ (current-indentation) 1)))
	      ((and percent-slash (tlc-in-multiline-comment)
		    (looking-at "\\s-*%"))
	       (setq i (+ (current-indentation) 0)))
	      (t
	       (let* ((nexti (tlc-calc-next-indentation)))
		 (setq i (+ (current-indentation)
			    (if (and indent-because-of-continuation
				     (or (> 0 i) percent-percent))
				i
			      (+ i nexti)))))
	       (if (< i 0) (setq i 0))))
	i))))

(defun tlc-calc-next-indentation ()
  "Calc how much more to indent the next line."
  (+
   (cond ((save-excursion
	    (and (not (tlc-assignment-continuation-p))
		 (tlc-beginning-of-statement))
	    (looking-at "\\s-*\\(\\(%\\(case\\|roll\\|with\\|if\\|for\\|\
foreach\\|while\\|else\\|elseif\\|default\\|function\\)\\>\\)\\|/%\\)"))
	  2)
	 ((looking-at "\\s-*%/")
	  -1)
	 ((looking-at "\\s-*\\(%switch\\)\\>")
	  4)
	 ;((looking-at "\\s-*%break\\>")
	 ; -2)
	 ((and (save-excursion (end-of-line)
			       (or (tlc-assignment-continuation-p)
				   (progn (forward-char -3)
					  (looking-at "\\\\$"))))
	       (save-excursion (forward-line -1)
			       (end-of-line)
			       (not
				(or (tlc-assignment-continuation-p)
				    (progn (forward-char -3)
					   (looking-at "\\\\$"))))))
	  (setq indent-because-of-continuation t)
	  2)
	 ((or (save-excursion (end-of-line)
			      (= (preceding-char) ?{))
	      )
	  2)
	 (t 0))
   (if (and (not (tlc-line-special))
	    (not (save-excursion (end-of-line)
				 (or (tlc-assignment-continuation-p)
				     (progn (forward-char -3)
					    (looking-at "\\\\$")))))
	    (save-excursion (forward-line -1)
			    (end-of-line)
			    (or (tlc-assignment-continuation-p)
				(progn (forward-char -3)
				       (looking-at "\\\\$")))))
       -2
     0)))

(defun tlc-beginning-of-statement ()
  "Goto the beginning of a statement, skipping over continuation lines."
  (beginning-of-line)
  (if (not (save-excursion (forward-line -1) (tlc-assignment-continuation-p)))
      nil
    (forward-line -1)
    (while (tlc-assignment-continuation-p)
      (forward-line -1))
    (forward-line 1)
    (beginning-of-line)))

(defun tlc-line-special ()
  "Return t if the current line is a special language line."
  (save-excursion
    (save-match-data
      (beginning-of-line)
      (looking-at "\\s-*\\(%[^<]\\|}\\)"))))

(defun tlc-assignment-continuation-p ()
  "See if continuation lines should be indented."
  (save-excursion
    (beginning-of-line)
    (and (progn (end-of-line) (forward-char -3) (looking-at "\\.\\.\\.")))))

(defun tlc-in-multiline-comment ()
  "Return t we are in a multiline comment."
  (save-excursion
    (save-match-data
      (if (re-search-backward "/%\\|%/" nil t)
	  (if (looking-at "/%")
	      t
	    nil)
	nil))))

;;; Add to mode list
;;;###autoload(add-to-list 'auto-mode-alist '("\\.tlc\\'" .tlc-mode))
(add-to-list 'auto-mode-alist '("\\.tlc\\'" .tlc-mode))

(provide 'tlc)

;;; tlc.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/boxquote.el0000775000000000000000000005041512230377265021443 0ustar  ;;; boxquote.el --- Quote text with a semi-box.
;; Copyright 1999-2009 by Dave Pearson 
;; $Revision: 1.4 $

;; boxquote.el is free software distributed under the terms of the GNU
;; General Public Licence, version 2 or (at your option) any later version.
;; For details see the file COPYING.

;;; Commentary:

;; boxquote provides a set of functions for using a text quoting style that
;; partially boxes in the left hand side of an area of text, such a marking
;; style might be used to show externally included text or example code.
;;
;; ,----
;; | The default style looks like this.
;; `----
;;
;; A number of functions are provided for quoting a region, a buffer, a
;; paragraph and a defun. There are also functions for quoting text while
;; pulling it in, either by inserting the contents of another file or by
;; yanking text into the current buffer.
;;
;; The latest version of boxquote.el can be found at:
;;
;;   

;;; Thanks:

;; Kai Grossjohann for inspiring the idea of boxquote. I wrote this code to
;; mimic the "inclusion quoting" style in his Usenet posts. I could have
;; hassled him for his code but it was far more fun to write it myself.
;;
;; Mark Milhollan for providing a patch that helped me get the help quoting
;; functions working with XEmacs.
;;
;; Oliver Much for suggesting the idea of having a `boxquote-kill-ring-save'
;; function.
;;
;; Reiner Steib for suggesting `boxquote-where-is' and the idea of letting
;; `boxquote-describe-key' describe key bindings from other buffers. Also
;; thanks go to Reiner for suggesting `boxquote-insert-buffer'.

;;; Code:

;; Things we need:

(eval-when-compile
  (require 'cl))
(require 'rect)

;; Attempt to handle older/other emacs.
(eval-and-compile
  
  ;; If customize isn't available just use defvar instead.
  (unless (fboundp 'defgroup)
    (defmacro defgroup  (&rest rest) nil)
    (defmacro defcustom (symbol init docstring &rest rest)
      `(defvar ,symbol ,init ,docstring)))
  
  ;; If `line-beginning-position' isn't available provide one.
  (unless (fboundp 'line-beginning-position)
    (defun line-beginning-position (&optional n)
      "Return the `point' of the beginning of the current line."
      (save-excursion
        (beginning-of-line n)
        (point))))

  ;; If `line-end-position' isn't available provide one.
  (unless (fboundp 'line-end-position)
    (defun line-end-position (&optional n)
      "Return the `point' of the end of the current line."
      (save-excursion
        (end-of-line n)
        (point)))))

;; Customize options.

(defgroup boxquote nil
  "Mark regions of text with a half-box."
  :group  'editing
  :prefix "boxquote-")

(defcustom boxquote-top-and-tail "----"
  "*Text that will be used at the top and tail of the box."
  :type  'string
  :group 'boxquote)

(defcustom boxquote-top-corner ","
  "*Text used for the top corner of the box."
  :type  'string
  :group 'boxquote)

(defcustom boxquote-bottom-corner "`"
  "*Text used for the bottom corner of the box."
  :type  'string
  :group 'boxquote)

(defcustom boxquote-side "| "
  "*Text used for the side of the box."
  :type  'string
  :group 'boxquote)

(defcustom boxquote-title-format "[ %s ]"
  "*Format string to use when creating a box title."
  :type  'string
  :group 'boxquote)

(defcustom boxquote-title-files t
  "*Should a `boxquote-insert-file' title the box with the file name?"
  :type '(choice
          (const :tag "Title the box with the file name" t)
          (const :tag "Don't title the box with the file name" nil))
  :group 'boxquote)

(defcustom boxquote-file-title-function #'file-name-nondirectory
  "*Function to apply to a file's name when using it to title a box."
  :type  'function
  :group 'boxquote)

(defcustom boxquote-title-buffers t
  "*Should a `boxquote-insert-buffer' title the box with the buffer name?"
  :type '(choice
          (const :tag "Title the box with the buffer name" t)
          (const :tag "Don't title the box with the buffer name" nil))
  :group 'boxquote)

(defcustom boxquote-buffer-title-function #'identity
  "*Function to apply to a buffer's name when using it to title a box."
  :type  'function
  :group 'boxquote)

(defcustom boxquote-region-hook nil
  "*Hooks to perform when on a region prior to boxquoting.

Note that all forms of boxquoting use `boxquote-region' to create the
boxquote. Because of this any hook you place here will be invoked by any of
the boxquoting functions."
  :type  'hook
  :group 'boxquote)

(defcustom boxquote-yank-hook nil
  "*Hooks to perform on the yanked text prior to boxquoting."
  :type  'hook
  :group 'boxquote)

(defcustom boxquote-insert-file-hook nil
  "*Hooks to perform on the text from an inserted file prior to boxquoting."
  :type  'hook
  :group 'boxquote)

(defcustom boxquote-kill-ring-save-title #'buffer-name
  "*Function for working out the title for a `boxquote-kill-ring-save'.

The string returned from this function will be used as the title for a
boxquote when the saved text is yanked into a buffer with \\[boxquote-yank].

An example of a non-trivial value for this variable might be:

  (lambda ()
    (if (string= mode-name \"Article\")
        (aref gnus-current-headers 4)
      (buffer-name)))

In this case, if you are a `gnus' user, \\[boxquote-kill-ring-save] could be
used to copy text from an article buffer and, when it is yanked into another
buffer using \\[boxquote-yank], the title of the boxquote would be the ID of
the article you'd copied the text from."
  :type  'function
  :group 'boxquote)

(defcustom boxquote-describe-function-title-format "C-h f %s RET"
  "*Format string to use when formatting a function description box title"
  :type  'string
  :group 'boxquote)

(defcustom boxquote-describe-variable-title-format "C-h v %s RET"
  "*Format string to use when formatting a variable description box title"
  :type  'string
  :group 'boxquote)

(defcustom boxquote-describe-key-title-format "C-h k %s"
  "*Format string to use when formatting a key description box title"
  :type  'string
  :group 'boxquote)

(defcustom boxquote-where-is-title-format "C-h w %s RET"
  "*Format string to use when formatting a `where-is' description box title"
  :type  'string
  :group 'boxquote)

(defcustom boxquote-where-is-body-format "%s is on %s"
  "*Format string to use when formatting a `where-is' description."
  :type  'string
  :group 'boxquote)
  
;; Main code:

(defun boxquote-xemacs-p ()
  "Are we running in XEmacs?"
  (and (boundp 'running-xemacs) (symbol-value 'running-xemacs)))

(defun boxquote-points ()
  "Find the start and end points of a boxquote.

If `point' is inside a boxquote then a cons is returned, the `car' is the
start `point' and the `cdr' is the end `point'. NIL is returned if no
boxquote is found."
  (save-excursion
    (beginning-of-line)
    (let* ((re-top    (concat "^" (regexp-quote boxquote-top-corner)
                              (regexp-quote boxquote-top-and-tail)))
           (re-left   (concat "^" (regexp-quote boxquote-side)))
           (re-bottom (concat "^" (regexp-quote boxquote-bottom-corner)
                              (regexp-quote boxquote-top-and-tail)))
           (points
            (flet ((find-box-end (re &optional back)
                     (save-excursion
                       (when (if back
                                 (search-backward-regexp re nil t)
                               (search-forward-regexp re nil t))
                         (point)))))
              (cond ((looking-at re-top)
                     (cons (point) (find-box-end re-bottom)))
                    ((looking-at re-left)
                     (cons (find-box-end re-top t) (find-box-end re-bottom)))
                    ((looking-at re-bottom)
                     (cons (find-box-end re-top t) (line-end-position)))))))
      (when (and (car points) (cdr points))
        points))))

(defun boxquote-quoted-p ()
  "Is `point' inside a boxquote?"
  (not (null (boxquote-points))))

(defun boxquote-points-with-check ()
  "Get the `boxquote-points' and flag an error of no box was found."
  (or (boxquote-points) (error "I can't see a box here")))

(defun boxquote-title-format-as-regexp ()
  "Return a regular expression to match the title."
  (with-temp-buffer
    (insert (regexp-quote boxquote-title-format))
    (setf (point) (point-min))
    (when (search-forward "%s" nil t)
      (replace-match ".*" nil t))
    (buffer-string)))

(defun boxquote-get-title ()
  "Get the title for the current boxquote."
  (multiple-value-bind (prefix-len suffix-len)
      (with-temp-buffer
        (let ((look-for "%s"))
          (insert boxquote-title-format)
          (setf (point) (point-min))
          (search-forward look-for)
          (list (- (point) (length look-for) 1) (- (point-max) (point)))))
    (save-excursion
      (save-restriction
        (boxquote-narrow-to-boxquote)
        (setf (point) (+ (point-min)
                         (length (concat boxquote-top-corner
                                         boxquote-top-and-tail))))
        (if (looking-at (boxquote-title-format-as-regexp))
            (buffer-substring-no-properties (+ (point) prefix-len)
                                            (- (line-end-position) suffix-len))
          "")))))

;;;###autoload
(defun boxquote-title (title)
  "Set the title of the current boxquote to TITLE.

If TITLE is an empty string the title is removed. Note that the title will
be formatted using `boxquote-title-format'."
  (interactive (list (read-from-minibuffer "Title: " (boxquote-get-title))))
  (save-excursion
    (save-restriction
      (boxquote-narrow-to-boxquote)
      (setf (point) (+ (point-min)
                       (length (concat boxquote-top-corner
                                       boxquote-top-and-tail))))
      (unless (eolp)
        (kill-line))
      (unless (zerop (length title))
        (insert (format boxquote-title-format title))))))

;;;###autoload
(defun boxquote-region (start end)
  "Draw a box around the left hand side of a region bounding START and END."
  (interactive "r")
  (save-excursion
    (save-restriction
      (flet ((bol-at-p (n)
               (setf (point) n)
               (bolp))
             (insert-corner (corner pre-break)
               (insert (concat (if pre-break "\n" "")
                               corner boxquote-top-and-tail "\n"))))
        (let ((break-start (not (bol-at-p start)))
              (break-end   (not (bol-at-p end))))
          (narrow-to-region start end)
          (run-hooks 'boxquote-region-hook)
          (setf (point) (point-min))
          (insert-corner boxquote-top-corner break-start)
          (let ((start-point (line-beginning-position)))
            (setf (point) (point-max))
            (insert-corner boxquote-bottom-corner break-end)
            (string-rectangle start-point
                              (progn
                                (setf (point) (point-max))
                                (forward-line -2)
                                (line-beginning-position))
                              boxquote-side)))))))

;;;###autoload
(defun boxquote-buffer ()
  "Apply `boxquote-region' to a whole buffer."
  (interactive)
  (boxquote-region (point-min) (point-max)))

;;;###autoload
(defun boxquote-insert-file (filename)
  "Insert the contents of a file, boxed with `boxquote-region'.

If `boxquote-title-files' is non-nil the boxquote will be given a title that
is the result of applying `boxquote-file-title-function' to FILENAME."
  (interactive "fInsert file: ")
  (insert (with-temp-buffer
            (insert-file-contents filename nil)
            (run-hooks 'boxquote-insert-file-hook)
            (boxquote-buffer)
            (when boxquote-title-files
              (boxquote-title (funcall boxquote-file-title-function filename)))
            (buffer-string))))

;;;###autoload
(defun boxquote-insert-buffer (buffer)
  "Insert the contents of a buffer, boxes with `boxquote-region'.

If `boxquote-title-buffers' is non-nil the boxquote will be given a title that
is the result of applying `boxquote-buffer-title-function' to BUFFER."
  (interactive "bInsert Buffer: ")
  (boxquote-text
   (with-current-buffer buffer
     (buffer-substring-no-properties (point-min) (point-max))))
  (when boxquote-title-buffers
    (boxquote-title (funcall boxquote-buffer-title-function buffer))))

;;;###autoload
(defun boxquote-kill-ring-save ()
  "Like `kill-ring-save' but remembers a title if possible.

The title is acquired by calling `boxquote-kill-ring-save-title'. The title
will be used by `boxquote-yank'."
  (interactive)
  (call-interactively #'kill-ring-save)
  (setf (car kill-ring-yank-pointer)
        (format "%S" (list
                      'boxquote-yank-marker
                      (funcall boxquote-kill-ring-save-title)
                      (car kill-ring-yank-pointer)))))

;;;###autoload
(defun boxquote-yank ()
  "Do a `yank' and box it in with `boxquote-region'.

If the yanked entry was placed on the kill ring with
`boxquote-kill-ring-save' the resulting boxquote will be titled with
whatever `boxquote-kill-ring-save-title' returned at the time."
  (interactive)
  (save-excursion
    (insert (with-temp-buffer
              (yank)
              (setf (point) (point-min))
              (let ((title
                     (let ((yanked (condition-case nil
                                       (read (current-buffer))
                                     (error nil))))
                       (when (listp yanked)
                         (when (eq (car yanked) 'boxquote-yank-marker)
                           (setf (buffer-string) (nth 2 yanked))
                           (nth 1 yanked))))))
                (run-hooks 'boxquote-yank-hook)
                (boxquote-buffer)
                (when title
                  (boxquote-title title))
                (buffer-string))))))

;;;###autoload
(defun boxquote-defun ()
  "Apply `boxquote-region' the current defun."
  (interactive)
  (mark-defun)
  (boxquote-region (region-beginning) (region-end)))

;;;###autoload
(defun boxquote-paragraph ()
  "Apply `boxquote-region' to the current paragraph."
  (interactive)
  (mark-paragraph)
  (boxquote-region (region-beginning) (region-end)))

;;;###autoload
(defun boxquote-boxquote ()
  "Apply `boxquote-region' to the current boxquote."
  (interactive)
  (let ((box (boxquote-points-with-check)))
    (boxquote-region (car box) (1+ (cdr box)))))

(defun boxquote-help-buffer-name (item)
  "Return the name of the help buffer associated with ITEM."
  (if (boxquote-xemacs-p)
      (loop for buffer in (symbol-value 'help-buffer-list)
            when (string-match (concat "^*Help:.*`" item "'") buffer)
            return buffer)
    "*Help*"))

(defun boxquote-quote-help-buffer (help-call title-format item)
  "Perform a help command and boxquote the output.

HELP-CALL is a function that calls the help command.

TITLE-FORMAT is the `format' string to use to product the boxquote title.

ITEM is a function for retrieving the item to get help on."
  (let ((one-window-p (one-window-p)))
    (boxquote-text
     (save-window-excursion
       (funcall help-call)
       (with-current-buffer (boxquote-help-buffer-name (funcall item))
         (buffer-substring-no-properties (point-min) (point-max)))))
    (boxquote-title (format title-format (funcall item)))
    (when one-window-p
      (delete-other-windows))))
  
;;;###autoload
(defun boxquote-describe-function ()
  "Call `describe-function' and boxquote the output into the current buffer."
  (interactive)
  (boxquote-quote-help-buffer
   #'(lambda ()
       (call-interactively #'describe-function))
   boxquote-describe-function-title-format
   #'(lambda ()
       (car (if (boxquote-xemacs-p)
                (symbol-value 'function-history)
              minibuffer-history)))))

;;;###autoload
(defun boxquote-describe-variable ()
  "Call `describe-variable' and boxquote the output into the current buffer."
  (interactive)
  (boxquote-quote-help-buffer
   #'(lambda ()
       (call-interactively #'describe-variable))
   boxquote-describe-variable-title-format
   #'(lambda ()
       (car (if (boxquote-xemacs-p)
                (symbol-value 'variable-history)
              minibuffer-history)))))

;;;###autoload
(defun boxquote-describe-key (key)
  "Call `describe-key' and boxquote the output into the current buffer.

If the call to this command is prefixed with \\[universal-argument] you will also be
prompted for a buffer. The key defintion used will be taken from that buffer."
  (interactive "kDescribe key: ")
  (let ((from-buffer (if current-prefix-arg
                         (read-buffer "Buffer: " (current-buffer) t)
                       (current-buffer))))
    (let ((binding
           (with-current-buffer from-buffer
             (key-binding key))))
      (if (or (null binding) (integerp binding))
          (message "%s is undefined" (with-current-buffer from-buffer
                                       (key-description key)))
        (boxquote-quote-help-buffer
         #'(lambda ()
             (with-current-buffer from-buffer
               (describe-key key)))
         boxquote-describe-key-title-format
         #'(lambda ()
             (with-current-buffer from-buffer
               (key-description key))))))))

;;;###autoload
(defun boxquote-shell-command (command)
  "Call `shell-command' with COMMAND and boxquote the output."
  (interactive (list (read-from-minibuffer "Shell command: " nil nil nil 'shell-command-history)))
  (boxquote-text (with-temp-buffer
                   (shell-command command t)
                   (buffer-string)))
  (boxquote-title command))

;;;###autoload
(defun boxquote-where-is (definition)
  "Call `where-is' with DEFINITION and boxquote the result."
  (interactive "CCommand: ")
  (boxquote-text (with-temp-buffer
                   (where-is definition t)
                   (format boxquote-where-is-body-format definition (buffer-string))))
  (boxquote-title (format boxquote-where-is-title-format definition)))

;;;###autoload
(defun boxquote-text (text)
  "Insert TEXT, boxquoted."
  (interactive "sText: ")
  (save-excursion
    (unless (bolp)
      (insert "\n"))
    (insert
     (with-temp-buffer
       (insert text)
       (boxquote-buffer)
       (buffer-string)))))
  
;;;###autoload
(defun boxquote-narrow-to-boxquote ()
  "Narrow the buffer to the current boxquote."
  (interactive)
  (let ((box (boxquote-points-with-check)))
    (narrow-to-region (car box) (cdr box))))

;;;###autoload
(defun boxquote-narrow-to-boxquote-content ()
  "Narrow the buffer to the content of the current boxquote."
  (interactive)
  (let ((box (boxquote-points-with-check)))
    (narrow-to-region (save-excursion
                        (setf (point) (car box))
                        (forward-line 1)
                        (point))
                      (save-excursion
                        (setf (point) (cdr box))
                        (line-beginning-position)))))

;;;###autoload
(defun boxquote-kill ()
  "Kill the boxquote and its contents."
  (interactive)
  (let ((box (boxquote-points-with-check)))
    (kill-region (car box) (1+ (cdr box)))))

;;;###autoload
(defun boxquote-fill-paragraph (arg)
  "Perform a `fill-paragraph' inside a boxquote."
  (interactive "P")
  (if (boxquote-quoted-p)
      (save-restriction
        (boxquote-narrow-to-boxquote-content)
        (let ((fill-prefix boxquote-side))
          (fill-paragraph arg)))
    (fill-paragraph arg)))
  
;;;###autoload
(defun boxquote-unbox-region (start end)
  "Remove a box created with `boxquote-region'."
  (interactive "r")
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (setf (point) (point-min))
      (if (looking-at (concat "^" (regexp-quote boxquote-top-corner)
                              (regexp-quote boxquote-top-and-tail)))
          (let ((ends (concat "^[" (regexp-quote boxquote-top-corner)
                              (regexp-quote boxquote-bottom-corner)
                              "]" boxquote-top-and-tail))
                (lines (concat "^" (regexp-quote boxquote-side))))
            (loop while (< (point) (point-max))
                  if (looking-at ends)  do (kill-line t)
                  if (looking-at lines) do (delete-char 2)
                  do (forward-line)))
        (error "I can't see a box here")))))

;;;###autoload
(defun boxquote-unbox ()
  "Remove the boxquote that contains `point'."
  (interactive)
  (let ((box (boxquote-points-with-check)))
    (boxquote-unbox-region (car box) (1+ (cdr box)))))

(provide 'boxquote)

;;; boxquote.el ends here.
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/home-end.el0000775000000000000000000000663412230377265021275 0ustar  ;;; home-end.el --- Alternative Home and End commands.
;; Copyright 1996 Kai Grossjohann and Toby Speight
;; Copyright 2002-2011 Toby Speight

;; home-end.el is free software distributed under the terms of the GNU
;; General Public Licence, version 3.


;;; Commentary:
;;
;; Some useful bindings for Home and End keys:
;; Hit the key once to go to the beginning/end of a line,
;; hit it twice in a row to go to the beginning/end of the window,
;; three times in a row goes to the beiginning/end of the buffer.
;; N.B. there is no timeout involved.
;;
;; To use:
;;  (global-set-key [end]  'home-end-end)
;;  (global-set-key [home] 'home-end-home)


;;; History:
;;
;; Kai Grossjohann 
;; 29 Jul 96:
;; Posted to Usenet.
;;
;; Modified by Toby Speight 
;; 1996-11-14:
;; Ensure that mark is set only when moving to beginning of window,
;; and is not set again when moving to beginning of buffer.
;;
;; Modified by Toby Speight >
;; 2002-07-12:
;; Added comments and license terms (with Kai's agreement).
;; Added autoload cookies.
;;
;; 2002-07-15:
;; Use `equal' instead of `eq' at suggestion of James LewisMoss
;; , for XEmacs compatibility.
;;
;; 2011-02-22:
;; Don't attempt to use `recent-keys' during keyboard macro definition
;; or replay.  Thanks to Dima Kogan  for the
;; patch.

(defvar home-end-marker)

;;;###autoload
(defun home-end-home (&optional arg)
  "Go to beginning of line/window/buffer.
First hitting key goes to beginning of line, second in a row goes to
beginning of window, third in a row goes to beginning of buffer."
  (interactive "P")
  (if (or executing-kbd-macro
          defining-kbd-macro)
      (move-beginning-of-line arg)
    (if arg
        (beginning-of-buffer arg)
      (let* ((keys (recent-keys))
             (len (length keys))
             (key1 (if (> len 0) (elt keys (- len 1)) nil))
             (key2 (if (> len 1) (elt keys (- len 2)) nil))
             (key3 (if (> len 2) (elt keys (- len 3)) nil))
             (key-equal-1 (equal key1 key2))
             (key-equal-2 (and key-equal-1 (equal key2 key3))))
        (cond (key-equal-2 (goto-char (point-min)))
              (key-equal-1 (push-mark home-end-marker)
                           (move-to-window-line 0))
              (t (setq home-end-marker (copy-marker (point)))
                 (beginning-of-line)))))))

;;;###autoload
(defun home-end-end (&optional arg)
  "Go to end of line/window/buffer.
First hitting key goes to end of line, second in a row goes to end
of window, third in a row goes to end of buffer."
  (interactive "P")
  (if (or executing-kbd-macro
          defining-kbd-macro)
      (move-end-of-line arg)
    (if arg
        (beginning-of-buffer arg)
      (let* ((keys (recent-keys))
             (len (length keys))
             (key1 (if (> len 0) (elt keys (- len 1)) nil))
             (key2 (if (> len 1) (elt keys (- len 2)) nil))
             (key3 (if (> len 2) (elt keys (- len 3)) nil))
             (key-equal-1 (equal key1 key2))
             (key-equal-2 (and key-equal-1 (equal key2 key3))))
        (cond (key-equal-2 (goto-char (point-max)))
              (key-equal-1 (push-mark home-end-marker)
                           (move-to-window-line -1)
                           (end-of-line))
              (t (setq home-end-marker (copy-marker (point)))
                 (end-of-line)))))))

(provide 'home-end)
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/services.el0000775000000000000000000001626312230377266021424 0ustar  ;;; services.el --- Services database access functions.
;; Copyright 2000-2008 by Dave Pearson 
;; $Revision: 1.4 $

;; services.el is free software distributed under the terms of the GNU
;; General Public Licence, version 2 or (at your option) any later version.
;; For details see the file COPYING.

;;; Commentary:
;;
;; services.el provides a set of functions for accessing the services
;; details list.
;;
;; The latest services.el is always available from:
;;
;;   

;;; BUGS:
;;
;; o Large parts of this code look like large parts of the code you'll find
;;   in protocols.el, this is unfortunate and makes me cringe. However, I
;;   also wanted them to be totally independant of each other. Suggestions
;;   of how to sweetly remedy this situation are welcome.

;;; INSTALLATION:
;;
;; o Drop services.el somwehere into your `load-path'. Try your site-lisp
;;   directory for example (you might also want to byte-compile the file).
;;
;; o Add the following autoload statement to your ~/.emacs file:
;;
;;   (autoload 'services-lookup      "services" "Perform a service lookup" t)
;;   (autoload 'services-clear-cache "services" "Clear the service cache"  t)

;;; Code:

;; Things we need:

(eval-when-compile
  (require 'cl))

;; Customisable variables.

(defvar services-file "/etc/services"
  "*Name of the services file.")

;; Non-customize variables.

(defvar services-cache nil
  "\"Cache\" of services.")

(defvar services-name-cache nil
  "\"Cache\" of service names.")

;; Main code:

(defsubst service-name (service)
  "Get the name of service SERVICE."
  (car service))

(defsubst service-port (service)
  "Get the port of service SERVICE."
  (cadr service))

(defsubst service-protocols (service)
  "Get the protocols of service SERVICE."
  (car (cddr service)))

(defsubst service-aliases (service)
  "Get the aliases for service SERVICE."
  (cadr (cddr service)))

(defun services-line-to-list (line)
  "Convert LINE from a string into a structured service list."
  (let* ((words (split-string line))
         (port (split-string (cadr words) "/")))
    (list
     (car words)
     (string-to-int (car port))
     (list (cadr port))
     (loop for s in (cddr words)
           while (not (= (aref s 0) ?#))
           collect s))))

(defun* services-read (&optional (file services-file))
  "Read the services list from FILE.

If FILE isn't supplied the value of `services-file' is used."
  (or services-cache
      (setq services-cache
            (when (file-readable-p file)
              (with-temp-buffer
                (insert-file-contents file)
                (setf (point) (point-min))
                (let ((services (list)))
                  (loop for service in
                        (loop until (eobp)
                              do (setf (point) (line-beginning-position))
                              unless (or (looking-at "^[ \t]*#") (looking-at "^[ \t]*$"))
                              collect (services-line-to-list (buffer-substring (line-beginning-position) (line-end-position)))
                              do (forward-line))
                        do (let ((hit (assoc (service-name service) services)))
                             (if (and hit (= (service-port hit) (service-port service)))
                                 (setf (cdr hit) (list
                                                  (service-port hit)
                                                  (append (service-protocols hit) (service-protocols service))
                                                  (service-aliases hit)))
                               (push service services)))
                        finally return (reverse services))))))))
      
(defun* services-find-by-name (name &optional (protocol "tcp") (services (services-read)))
  "Find the service whose name is NAME."
  (loop for service in services
        when (and (string= (service-name service) name)
                  (member protocol (service-protocols service)))
        return service))

(defun* services-find-by-port (port &optional (protocol "tcp") (services (services-read)))
  "Find the service whose port is PORT."
  (loop for service in services
        when (and (= (service-port service) port)
                  (member protocol (service-protocols service)))
        return service))

(defun* services-find-by-alias (alias &optional (protocol "tcp") (services (services-read)))
  "Find a the service whose with an alias of ALIAS."
  (loop for service in services
        when (and (member alias (service-aliases service))
                  (member protocol (service-protocols service)))
        return service))

;;;###autoload
(defun services-lookup (search protocol)
  "Find a service and display its details."
  (interactive (list
                (completing-read "Service Search: "
                                 (or services-name-cache
                                     (setq services-name-cache
                                           (loop for service in (services-read)
                                                 collect (list (service-name service))
                                                 append (loop for alias in (service-aliases service)
                                                              collect (list alias)))))
                                 nil nil "" nil)
                (completing-read "Protocol: " '(("tcp") ("udp")) nil nil "tcp" nil)))
  (let* ((services (services-read))
         (service (or (when (string-match "^[0-9]+$" search)
                        (services-find-by-port (string-to-int search) protocol services))
                      (services-find-by-name search protocol services)
                      (services-find-by-name (downcase search) protocol services)
                      (services-find-by-name (upcase search) protocol services)
                      (services-find-by-alias search protocol services)
                      (services-find-by-alias (downcase search) protocol services)
                      (services-find-by-alias (upcase search) protocol services))))
    (if service
        (let ((aliases (service-aliases service))
              (protocols (service-protocols service)))
          (message "Service: %s  Port: %d  %s%s"
                   (service-name service)
                   (service-port service)
                   (if aliases
                       (format "Aliases: %s"
                               (with-output-to-string
                                   (loop for alias in (service-aliases service)
                                         do (princ alias) (princ " "))))
                     "")
                   (if protocols
                       (format "%sProtocols: %s"
                               (if aliases " " "")
                               (with-output-to-string
                                   (loop for protocol in protocols
                                         do (princ protocol) (princ " "))))
                     "")))
      (error "No service matching \"%s\" using protocol %s" search protocol))))

;;;###autoload
(defun services-clear-cache ()
  "Clear the services \"cache\"."
  (interactive)
  (setq services-cache      nil
        services-name-cache nil))

(provide 'services)

;;; services.el ends here.
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/initsplit.el0000775000000000000000000001511712230377265021614 0ustar  ;;; initsplit --- code to split customizations into different files

;; Copyright (C) 2000, 2001 John Wiegley

;; Author: John Wiegley 
;; Created:  8 Feb 2000
;; Version: 1.6
;; Keywords: lisp
;; X-URL: http://www.gci-net.com/users/j/johnw/emacs.html

;; 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 2, 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This file allows you to split Emacs customizations (set via M-x
;; customize) into different files, based on the names of the
;; variables.  It uses a regexp to match against each face and
;; variable name, and associates with a file that the variable should
;; be stored in.

;; To use it, just load the file in your .emacs:
;;
;;   (load "initsplit")
;;
;; If you want configuration files byte-compiled, add this after it:
;;
;;   (add-hook 'after-save-hook 'initsplit-byte-compile-files t)

;; Note that that you *must* load each file that contains your various
;; customizations from your .emacs.  Otherwise, the variables won't
;; all be set, and the next time you use the customize interface, it
;; will delete the settings in those other files.

;; Then, customize the variable `initsplit-customizations-alist', to
;; associate various configuration names with their respective
;; initialization files.

;; I find this module most useful for splitting up Gnus and Viper
;; customizations.

;;; History:

;;; Code:

(defconst initsplit-version "1.6"
  "This version of initsplit.")

(defgroup initsplit nil
  "Code to split customizations into different files."
  :group 'initialization)

;;; User Variables:

(defcustom initsplit-load-hook nil
  "*A hook that gets run after \"initsplit.el\" has been loaded."
  :type 'hook
  :group 'initsplit)

(defcustom initsplit-customizations-alist nil
  "*An alist that describes how to split up init file customizations."
  :type '(repeat
	  (list (regexp  :tag "Var regexp")
		(file    :tag "Custom file")
		(boolean :tag "Byte-compile")))
  :group 'initsplit)

(defcustom initsplit-sort-customizations
  (and (boundp 'emacs-major-version)
       (= emacs-major-version 20))
  "*If non-nil, sort the arguments to `custom-set-variables'."
  :type 'boolean
  :group 'initsplit)

;;; User Functions:

(defun initsplit-narrow-to-custom (&optional faces)
  (goto-char (point-min))
  (let (pos)
    (if (re-search-forward
	 (format "^(custom-set-%s"
		 (if faces "faces" "variables")) nil t)
	(setq pos (match-beginning 0))
      (goto-char (point-max))
      (insert "\n")
      (setq pos (point))
      (insert (format "(custom-set-%s)"
		      (if faces "faces" "variables"))) )
    (goto-char pos))
  (let ((beg (point)))
    (forward-sexp)
    (narrow-to-region beg (point)))
  (goto-char (point-min))
  (forward-line))

(defun initsplit-delete-customizations (&optional faces)
  "Delete all of the customization entries in a buffer."
  (save-restriction
    (initsplit-narrow-to-custom faces)
    (forward-char -1)
    (while (not (looking-at ")"))
      (let ((opoint (point)))
	(forward-sexp)
	(delete-region opoint (point))))))

(defun initsplit-sort-customizations (&optional faces)
  "Sort the customization entries in a buffer."
  (save-restriction
    (initsplit-narrow-to-custom faces)
    (sort-subr
     nil
     (function
      (lambda ()
	(if (looking-at ")")
	    (goto-char (point-max))
	  (forward-char))))
     (function
      (lambda ()
	(backward-up-list 1)
	(forward-sexp)))
     (function
      (lambda ()
	(re-search-forward "'(\\(\\S-+\\)")
	(match-string 1))))))

(defvar initsplit-modified-buffers nil)

(defun initsplit-split-customizations (&optional faces)
  (save-restriction
    (initsplit-narrow-to-custom faces)
    (while (looking-at "^\\s-*\\(;;\\|'(\\(\\S-+\\)\\)")
      (let ((var (match-string 2))
	    (cal initsplit-customizations-alist)
	    found)
	(while (and var cal)
	  (if (not (string-match (caar cal) var))
	      (setq cal (cdr cal))
	    (setq found t)
	    (let ((opoint (point)))
	      (forward-sexp)
	      (kill-region opoint (point))
	      (if (looking-at "^\\s-*)")
		  (delete-indentation)
		(delete-char 1)))
	    (with-current-buffer
		(find-file-noselect (nth 1 (car cal)))
	      (unless (memq (current-buffer) initsplit-modified-buffers)
		(setq initsplit-modified-buffers
		      (cons (current-buffer) initsplit-modified-buffers))
		(initsplit-delete-customizations)
		(initsplit-delete-customizations t))
	      (save-restriction
		(initsplit-narrow-to-custom faces)
		(forward-char -1)
		(insert ?\n)
		(yank)))
	    (setq cal nil)))
	(unless found
	  (forward-sexp)
	  (forward-line))))))

(defun initsplit-split-user-init-file ()
  (save-excursion
    (if (string= (file-truename (buffer-file-name (current-buffer)))
		 (file-truename (or custom-file user-init-file)))
	(let (initsplit-modified-buffers)
	  (initsplit-split-customizations)
	  (initsplit-split-customizations t)
	  (while initsplit-modified-buffers
	    (with-current-buffer (car initsplit-modified-buffers)
	      (when initsplit-sort-customizations
		(initsplit-sort-customizations)
		(initsplit-sort-customizations t))
	      (save-buffer))
	    (setq initsplit-modified-buffers
		  (cdr initsplit-modified-buffers)))
	  (when initsplit-sort-customizations
	    (initsplit-sort-customizations)
	    (initsplit-sort-customizations t))))
    nil))

(add-hook 'write-file-hooks 'initsplit-split-user-init-file t)

(defun initsplit-byte-compile-files ()
  (if (string= (file-truename (buffer-file-name (current-buffer)))
	       (file-truename (or custom-file user-init-file)))
      (byte-compile-file (file-truename
			  (buffer-file-name (current-buffer))))
    (let ((cal initsplit-customizations-alist))
      (while cal
	(if (and (nth 2 (car cal))
		 (string= (file-truename (nth 1 (car cal)))
			  (file-truename
			   (buffer-file-name (current-buffer)))))
	    (byte-compile-file (file-truename
				(buffer-file-name (current-buffer)))))
	(setq cal (cdr cal))))))

;;(add-hook 'after-save-hook 'initsplit-byte-compile-files t)

;;; Internal Functions:

(provide 'initsplit)

(run-hooks 'initsplit-load-hook)

;;; initsplit.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/sys-apropos.el0000775000000000000000000000742012230377266022073 0ustar  ;; sys-apropos.el --- Interface for the *nix apropos command.

;; Copyright (C) 2002 Henrik Enberg 

;; Author: Henrik Enberg 
;; Keywords: help, external

;; This file is not part of GNU Emacs.

;; 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 2 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, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
;;; Commentary:

;;; Commentary:

;; To install, drop it in a directory on your `load-path', and add
;; the following to your .emacs:

;;	(autoload 'sys-apropos "sys-apropos" nil t)

;; Then do `M-x sys-apropos' and you're off.  In the *System Apropos*
;; buffer, `RET' shows the manual for the program on that line and `q'
;; or `C-c C-c' quits the whole shebang.

;;; Code:

(require 'man)

(defvar sys-apropos-line-regexp
  "^\\([a-z0-9-_]+\\)[ \t]*(\\([0-9]\\))[ \t-]+\\(.*\\)"
  "Regexp matching a line of output from the apropos command.")

;;;###autoload
(defun sys-apropos (query)
  "Ask the system apropos command for man-pages matching QUERY."
  (interactive "sApropos query: ")
  (let ((command (concat "apropos " query))
	(longest-name 0)
	(output nil))
    (with-temp-buffer
      (insert (shell-command-to-string command))
      (goto-char (point-min))
      (while (re-search-forward sys-apropos-line-regexp nil t)
	(push (list (match-string 1)
		    (match-string 2)
		    (match-string 3))
	      output)
	(when (> (length (match-string 1)) longest-name)
	  (setq longest-name (length (match-string 1))))
	(forward-line 1)))
    (if (not output)
	(message "%s: nothing appropriate." query)
      (let ((buffer (get-buffer-create "*System Apropos*"))
	    (inhibit-read-only t))
	(pop-to-buffer buffer)
	(erase-buffer)
	(setq output (nreverse output))
	(dolist (i output)
	  (let ((name (format "%s (%s)" (nth 0 i) (nth 1 i)))
		(desciption (nth 2 i))
		(max-len (+ longest-name 4))
		(pad-char ? ))
	    (insert (propertize
		     (if (< (length name) max-len)
			 (concat name (make-string
				       (- max-len (length name))
				       pad-char))
		       name) 'face 'bold)
		    " - " desciption "\n")))
	(goto-char (point-min))
	(sys-apropos-mode)))))

(defun sys-apropos-run-man ()
  "Show the man page on the current line."
  (interactive)
  (let ((beg (line-beginning-position))
	(end (line-end-position))
	(line nil))
    (setq line (buffer-substring-no-properties beg end))
    (with-temp-buffer
      (insert line)
      (goto-char (point-min))
      (when (re-search-forward sys-apropos-line-regexp nil t)
	(let ((man-arg (concat (match-string 2) " " (match-string 1))))
	  (Man-getpage-in-background man-arg))))))

(defun sys-apropos-quit ()
  "Exit from the `sys-apropos' buffer."
  (interactive)
  (when (eq major-mode 'sys-apropos-mode)
    (kill-buffer (current-buffer))
    (when (/= (count-windows) 1)
      (delete-window))))

(define-derived-mode sys-apropos-mode fundamental-mode "System Apropos"
  "Major mode used in `sys-apropos' buffers.

\\{sys-apropos-mode-map}"
  (define-key sys-apropos-mode-map (kbd "RET") 'sys-apropos-run-man)
  (define-key sys-apropos-mode-map (kbd "C-c C-c") 'sys-apropos-quit)
  (define-key sys-apropos-mode-map (kbd "q") 'sys-apropos-quit)
  (setq truncate-lines t
	buffer-read-only t))

(provide 'sys-apropos)

;;; sys-apropos.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/markdown-mode.el0000664000000000000000000057371712230377265022355 0ustar  ;;; markdown-mode.el --- Emacs Major mode for Markdown-formatted text files

;; Copyright (C) 2007-2013 Jason R. Blevins 
;; Copyright (C) 2007, 2009 Edward O'Connor 
;; Copyright (C) 2007 Conal Elliott 
;; Copyright (C) 2008 Greg Bognar 
;; Copyright (C) 2008 Dmitry Dzhus 
;; Copyright (C) 2008 Bryan Kyle 
;; Copyright (C) 2008 Ben Voui 
;; Copyright (C) 2009 Ankit Solanki 
;; Copyright (C) 2009 Hilko Bengen 
;; Copyright (C) 2009 Peter Williams 
;; Copyright (C) 2010 George Ogata 
;; Copyright (C) 2011 Eric Merritt 
;; Copyright (C) 2011 Philippe Ivaldi 
;; Copyright (C) 2011 Jeremiah Dodds 
;; Copyright (C) 2011 Christopher J. Madsen 
;; Copyright (C) 2011 Shigeru Fukaya 
;; Copyright (C) 2011 Joost Kremers 
;; Copyright (C) 2011-2012 Donald Ephraim Curtis 
;; Copyright (C) 2012 Akinori Musha 
;; Copyright (C) 2012 Zhenlei Jia 
;; Copyright (C) 2012 Peter Jones 
;; Copyright (C) 2013 Matus Goljer 

;; Author: Jason R. Blevins 
;; Maintainer: Jason R. Blevins 
;; Created: May 24, 2007
;; Version: 2.0
;; Keywords: Markdown, GitHub Flavored Markdown, itex
;; URL: http://jblevins.org/projects/markdown-mode/

;; This file is not part of GNU Emacs.

;; 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 2, 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, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; markdown-mode is a major mode for editing [Markdown][]-formatted
;; text files in GNU Emacs.  markdown-mode is free software, licensed
;; under the GNU GPL.
;;
;;  [Markdown]: http://daringfireball.net/projects/markdown/
;;
;; The latest stable version is markdown-mode 2.0, released on March 24, 2013:
;;
;;    * [markdown-mode.el][]
;;    * [Screenshot][][^theme]
;;    * [Release notes][]
;;
;;  [markdown-mode.el]: http://jblevins.org/projects/markdown-mode/markdown-mode.el
;;  [screenshot]: http://jblevins.org/projects/markdown-mode/screenshots/20130131-002.png
;;  [release notes]: http://jblevins.org/projects/markdown-mode/rev-2-0
;;
;; [^theme]: The theme used in the screenshot is
;;   [color-theme-twilight](https://github.com/crafterm/twilight-emacs).
;;
;; markdown-mode is also available in several package managers, including:
;;
;;    * Debian and Ubuntu Linux: [emacs-goodies-el][]
;;    * RedHat and Fedora Linux: [emacs-goodies][]
;;    * OpenBSD: [textproc/markdown-mode][]
;;    * Arch Linux (AUR): [emacs-markdown-mode-git][]
;;    * MacPorts: [markdown-mode.el][macports-package] ([pending][macports-ticket])
;;    * FreeBSD: [textproc/markdown-mode.el][freebsd-port]
;;
;;  [emacs-goodies-el]: http://packages.debian.org/emacs-goodies-el
;;  [emacs-goodies]: https://admin.fedoraproject.org/pkgdb/acls/name/emacs-goodies
;;  [textproc/markdown-mode]: http://pkgsrc.se/textproc/markdown-mode
;;  [emacs-markdown-mode-git]: http://aur.archlinux.org/packages.php?ID=30389
;;  [macports-package]: https://trac.macports.org/browser/trunk/dports/editors/markdown-mode.el/Portfile
;;  [macports-ticket]: http://trac.macports.org/ticket/35716
;;  [freebsd-port]: http://svnweb.freebsd.org/ports/head/textproc/markdown-mode.el
;;
;; The latest development version can be downloaded directly
;; ([markdown-mode.el][devel.el]) or it can be obtained from the
;; (browsable and clonable) Git repository at
;; .  The entire repository,
;; including the full project history, can be cloned via the Git protocol
;; by running
;;
;;     git clone git://jblevins.org/git/markdown-mode.git
;;
;;  [devel.el]: http://jblevins.org/git/markdown-mode.git/plain/markdown-mode.el

;;; Installation:

;; Make sure to place `markdown-mode.el` somewhere in the load-path and add
;; the following lines to your `.emacs` file to associate markdown-mode
;; with `.text`, `.markdown`, and `.md` files:
;;
;;     (autoload 'markdown-mode "markdown-mode"
;;        "Major mode for editing Markdown files" t)
;;     (add-to-list 'auto-mode-alist '("\\.text\\'" . markdown-mode))
;;     (add-to-list 'auto-mode-alist '("\\.markdown\\'" . markdown-mode))
;;     (add-to-list 'auto-mode-alist '("\\.md\\'" . markdown-mode))
;;
;; There is no official Markdown file extension, nor is there even a
;; _de facto_ standard, so you can easily add, change, or remove any
;; of the file extensions above as needed.

;;; Usage:

;; Keybindings are grouped by prefixes based on their function.  For
;; example, the commands for inserting links are grouped under `C-c
;; C-a`, where the `C-a` is a mnemonic for the HTML `` tag.  In
;; other cases, the connection to HTML is not direct.  For example,
;; commands dealing with headings begin with `C-c C-t` (mnemonic:
;; titling).  The primary commands in each group will are described
;; below.  You can obtain a list of all keybindings by pressing `C-c
;; C-h`.  Movement and shifting commands tend to be associated with
;; paired delimiters such as `M-{` and `M-}` or `C-c <` and `C-c >`.
;; Outline navigation keybindings the same as in `org-mode'.  Finally,
;; commands for running Markdown or doing maintenance on an open file
;; are grouped under the `C-c C-c` prefix.  The most commonly used
;; commands are described below.  You can obtain a list of all
;; keybindings by pressing `C-c C-h`.
;;
;;   * Hyperlinks: `C-c C-a`
;;
;;     In this group, `C-c C-a l` inserts an inline link of the form
;;     `[text](url)`.  The link text is determined as follows.  First,
;;     if there is an active region (i.e., when transient mark mode is
;;     on and the mark is active), use it as the link text.  Second,
;;     if the point is at a word, use that word as the link text.  In
;;     these two cases, the original text will be replaced with the
;;     link and point will be left at the position for inserting a
;;     URL.  Otherwise, insert empty link markup and place the point
;;     for inserting the link text.
;;
;;     `C-c C-a L` inserts a reference link of the form `[text][label]`
;;     and, optionally, a corresponding reference label definition.
;;     The link text is determined in the same way as with an inline
;;     link (using the region, when active, or the word at the point),
;;     but instead of inserting empty markup as a last resort, the
;;     link text will be read from the minibuffer.  The reference
;;     label will be read from the minibuffer in both cases, with
;;     completion from the set of currently defined references.  To
;;     create an implicit reference link, press `RET` to accept the
;;     default, an empty label.  If the entered referenced label is
;;     not defined, additionally prompt for the URL and (optional)
;;     title.  If a URL is provided, a reference definition will be
;;     inserted in accordance with `markdown-reference-location'.
;;     If a title is given, it will be added to the end of the
;;     reference definition and will be used to populate the title
;;     attribute when converted to XHTML.
;;
;;     `C-c C-a u` inserts a bare url, delimited by angle brackets.  When
;;     there is an active region, the text in the region is used as the
;;     URL.  If the point is at a URL, that url is used.  Otherwise,
;;     insert angle brackets and position the point in between them
;;     for inserting the URL.
;;
;;     `C-c C-a f` inserts a footnote marker at the point, inserts a
;;     footnote definition below, and positions the point for
;;     inserting the footnote text.  Note that footnotes are an
;;     extension to Markdown and are not supported by all processors.
;;
;;     `C-c C-a w` behaves much like the inline link insertion command
;;     and inserts a wiki link of the form `[[WikiLink]]`.  If there
;;     is an active region, use the region as the link text.  If the
;;     point is at a word, use the word as the link text.  If there is
;;     no active region and the point is not at word, simply insert
;;     link markup.  Note that wiki links are an extension to Markdown
;;     and are not supported by all processors.
;;
;;   * Images: `C-c C-i`
;;
;;     `C-c C-i i` inserts markup for an inline image, using the
;;     active region or the word at point, if any, as the alt text.
;;     `C-c C-i I` behaves similarly and inserts a reference-style
;;     image.
;;
;;   * Styles: `C-c C-s`
;;
;;     `C-c C-s e` inserts markup to make a region or word italic (`e`
;;     for `` or emphasis).  If there is an active region, make
;;     the region italic.  If the point is at a non-italic word, make
;;     the word italic.  If the point is at an italic word or phrase,
;;     remove the italic markup.  Otherwise, simply insert italic
;;     delimiters and place the cursor in between them.  Similarly,
;;     use `C-c C-s s` for bold (``) and `C-c C-s c` for
;;     inline code (``).
;;
;;     `C-c C-s b` inserts a blockquote using the active region, if any,
;;     or starts a new blockquote.  `C-c C-s C-b` is a variation which
;;     always operates on the region, regardless of whether it is
;;     active or not.  The appropriate amount of indentation, if any,
;;     is calculated automatically given the surrounding context, but
;;     may be adjusted later using the region indentation commands.
;;
;;     `C-c C-s p` behaves similarly for inserting preformatted code
;;     blocks, with `C-c C-s C-p` being the region-only counterpart.
;;
;;   * Headings: `C-c C-t`
;;
;;     All heading insertion commands use the text in the active
;;     region, if any, as the heading text.  Otherwise, if the current
;;     line is not blank, they use the text on the current line.
;;     Finally, the setext commands will prompt for heading text if
;;     there is no active region and the current line is blank.
;;     
;;     `C-c C-t h` inserts a heading with automatically chosen type and
;;     level (both determined by the previous heading).  `C-c C-t H`
;;     behaves similarly, but uses setext (underlined) headings when
;;     possible, still calculating the level automatically.
;;     In cases where the automatically-determined level is not what
;;     you intended, the level can be quickly promoted or demoted
;;     (as described below).  Alternatively, a `C-u` prefix can be
;;     given to insert a heading promoted by one level or a `C-u C-u`
;;     prefix can be given to insert a heading demoted by one level.
;;
;;     To insert a heading of a specific level and type, use `C-c C-t 1`
;;     through `C-c C-t 6` for atx (hash mark) headings and `C-c C-t !` or
;;     `C-c C-t @` for setext headings of level one or two, respectively.
;;     Note that `!` is `S-1` and `@` is `S-2`.
;;
;;     If the point is at a heading, these commands will replace the
;;     existing markup in order to update the level and/or type of the
;;     heading.  To remove the markup of the heading at the point,
;;     press `C-c C-k` to kill the heading and press `C-y` to yank the
;;     heading text back into the buffer.
;;
;;   * Horizontal Rules: `C-c -`
;;
;;     `C-c -` inserts a horizontal rule.  By default, insert the
;;     first string in the list `markdown-hr-strings' (the most
;;     prominent rule).  With a `C-u` prefix, insert the last string.
;;     With a numeric prefix `N`, insert the string in position `N`
;;     (counting from 1).
;;
;;   * Markdown and Maintenance Commands: `C-c C-c`
;;
;;     *Compile:* `C-c C-c m` will run Markdown on the current buffer
;;     and show the output in another buffer.  *Preview*: `C-c C-c p`
;;     runs Markdown on the current buffer and previews, stores the
;;     output in a temporary file, and displays the file in a browser.
;;     *Export:* `C-c C-c e` will run Markdown on the current buffer
;;     and save the result in the file `basename.html`, where
;;     `basename` is the name of the Markdown file with the extension
;;     removed.  *Export and View:* press `C-c C-c v` to export the
;;     file and view it in a browser.  **For both export commands, the
;;     output file will be overwritten without notice.**
;;     *Open:* `C-c C-c o` will open the Markdown source file directly
;;     using `markdown-open-command'.
;;
;;     To summarize:
;;
;;       - `C-c C-c m`: `markdown-command' > `*markdown-output*` buffer.
;;       - `C-c C-c p`: `markdown-command' > temporary file > browser.
;;       - `C-c C-c e`: `markdown-command' > `basename.html`.
;;       - `C-c C-c v`: `markdown-command' > `basename.html` > browser.
;;       - `C-c C-c w`: `markdown-command' > kill ring.
;;       - `C-c C-c o`: `markdown-open-command'.
;;
;;     `C-c C-c c` will check for undefined references.  If there are
;;     any, a small buffer will open with a list of undefined
;;     references and the line numbers on which they appear.  In Emacs
;;     22 and greater, selecting a reference from this list and
;;     pressing `RET` will insert an empty reference definition at the
;;     end of the buffer.  Similarly, selecting the line number will
;;     jump to the corresponding line.
;;
;;     `C-c C-c n` renumbers any ordered lists in the buffer that are
;;     out of sequence.
;;
;;     `C-c C-c ]` completes all headings and normalizes all horizontal
;;     rules in the buffer.
;;
;;   * Following Links: `C-c C-o`
;;
;;     Press `C-c C-o` when the point is on an inline or reference
;;     link to open the URL in a browser.  When the point is at a
;;     wiki link, open it in another buffer (in the current window,
;;     or in the other window with the `C-u` prefix).  Use `M-p` and
;;     `M-n` to quickly jump to the previous or next link of any type.
;;
;;   * Jumping: `C-c C-j`
;;
;;     Use `C-c C-j` to jump from the object at point to its counterpart
;;     elsewhere in the text, when possible.  Jumps between reference
;;     links and definitions; between footnote markers and footnote
;;     text.  If more than one link uses the same reference name, a
;;     new buffer will be created containing clickable buttons for jumping
;;     to each link.  You may press `TAB` or `S-TAB` to jump between
;;     buttons in this window.
;;
;;   * Promotion and Demotion: `C-c C--` and `C-c C-=`
;;
;;     Headings, horizontal rules, and list items can be promoted and
;;     demoted, as well as bold and italic text.  For headings,
;;     "promotion" means *decreasing* the level (i.e., moving from
;;     `
` to `
`) while "demotion" means *increasing* the
;;     level.  For horizontal rules, promotion and demotion means
;;     moving backward or forward through the list of rule strings in
;;     `markdown-hr-strings'.  For bold and italic text, promotion and
;;     demotion means changing the markup from underscores to asterisks.
;;     Press `C-c C--` or `M-LEFT` to promote the element at the point
;;     if possible.
;;
;;     To remember these commands, note that `-` is for decreasing the
;;     level (promoting), and `=` (on the same key as `+`) is for
;;     increasing the level (demoting).  Similarly, the left and right
;;     arrow keys indicate the direction that the atx heading markup
;;     is moving in when promoting or demoting.
;;
;;   * Completion: `C-c C-]`
;;
;;     Complete markup is in normalized form, which means, for
;;     example, that the underline portion of a setext header is the
;;     same length as the heading text, or that the number of leading
;;     and trailing hash marks of an atx header are equal and that
;;     there is no extra whitespace in the header text.  `C-c C-]`
;;     completes the markup at the point, if it is determined to be
;;     incomplete.
;;
;;   * Editing Lists: `M-RET`, `M-UP`, `M-DOWN`, `M-LEFT`, and `M-RIGHT`
;;
;;     New list items can be inserted with `M-RET`.  This command
;;     determines the appropriate marker (one of the possible
;;     unordered list markers or the next number in sequence for an
;;     ordered list) and indentation level by examining nearby list
;;     items.  If there is no list before or after the point, start a
;;     new list.  Prefix this command by `C-u` to decrease the
;;     indentation by one level.  Prefix this command by `C-u C-u` to
;;     increase the indentation by one level.
;;
;;     Existing list items can be moved up or down with `M-UP` or
;;     `M-DOWN` and indented or exdented with `M-RIGHT` or `M-LEFT`.
;;
;;   * Shifting the Region: `C-c <` and `C-c >`
;;
;;     Text in the region can be indented or exdented as a group using
;;     `C-c >` to indent to the next indentation point (calculated in
;;     the current context), and `C-c <` to exdent to the previous
;;     indentation point.  These keybindings are the same as those for
;;     similar commands in `python-mode'.
;;
;;   * Killing Elements: `C-c C-k`
;;
;;     Press `C-c C-k` to kill the thing at point and add important
;;     text, without markup, to the kill ring.  Possible things to
;;     kill include (roughly in order of precedece): inline code,
;;     headings, horizonal rules, links (add link text to kill ring),
;;     images (add alt text to kill ring), angle URIs, email
;;     addresses, bold, italics, reference definitions (add URI to
;;     kill ring), footnote markers and text (kill both marker and
;;     text, add text to kill ring), and list items.
;;
;;   * Outline Navigation: `C-c C-n`, `C-c C-p`, `C-c C-f`, `C-c C-b`, and `C-c C-u`
;;
;;     Navigation between headings is possible using `outline-mode'.
;;     Use `C-c C-n` and `C-c C-p` to move between the next and previous
;;     visible headings.  Similarly, `C-c C-f` and `C-c C-b` move to the
;;     next and previous visible headings at the same level as the one
;;     at the point.  Finally, `C-c C-u` will move up to a lower-level
;;     (higher precedence) visible heading.
;;
;;   * Movement by Paragraph or Block: `M-{` and `M-}`
;;
;;     The definition of a "paragraph" is slightly different in
;;     markdown-mode than, say, text-mode, because markdown-mode
;;     supports filling for list items and respects hard line breaks,
;;     both of which break paragraphs.  So, markdown-mode overrides
;;     the usual paragraph navigation commands `M-{` and `M-}` so that
;;     with a `C-u` prefix, these commands jump to the beginning or
;;     end of an entire block of text, respectively, where "blocks"
;;     are separated by one or more lines.
;;
;;   * Movement by Defun: `C-M-a`, `C-M-e`, and `C-M-h`
;;
;;     The usual Emacs commands can be used to move by defuns
;;     (top-level major definitions).  In markdown-mode, a defun is a
;;     section.  As usual, `C-M-a` will move the point to the
;;     beginning of the current or preceding defun, `C-M-e` will move
;;     to the end of the current or following defun, and `C-M-h` will
;;     put the region around the entire defun.
;;
;; As noted, many of the commands above behave differently depending
;; on whether Transient Mark mode is enabled or not.  When it makes
;; sense, if Transient Mark mode is on and the region is active, the
;; command applies to the text in the region (e.g., `C-c C-s s` makes the
;; region bold).  For users who prefer to work outside of Transient
;; Mark mode, since Emacs 22 it can be enabled temporarily by pressing
;; `C-SPC C-SPC`.  When this is not the case, many commands then
;; proceed to look work with the word or line at the point.
;;
;; When applicable, commands that specifically act on the region even
;; outside of Transient Mark mode have the same keybinding as their
;; standard counterpart, but the letter is uppercase.  For example,
;; `markdown-insert-blockquote' is bound to `C-c C-s b` and only acts on
;; the region in Transient Mark mode while `markdown-blockquote-region'
;; is bound to `C-c C-s B` and always applies to the region (when nonempty).
;;
;; Note that these region-specific functions are useful in many
;; cases where it may not be obvious.  For example, yanking text from
;; the kill ring sets the mark at the beginning of the yanked text
;; and moves the point to the end.  Therefore, the (inactive) region
;; contains the yanked text.  So, `C-y` followed by `C-c C-s C-b` will
;; yank text and turn it into a blockquote.
;;
;; markdown-mode attempts to be flexible in how it handles
;; indentation.  When you press `TAB` repeatedly, the point will cycle
;; through several possible indentation levels corresponding to things
;; you might have in mind when you press `RET` at the end of a line or
;; `TAB`.  For example, you may want to start a new list item,
;; continue a list item with hanging indentation, indent for a nested
;; pre block, and so on.  Exdention is handled similarly when backspace
;; is pressed at the beginning of the non-whitespace portion of a line.
;;
;; markdown-mode supports outline-minor-mode as well as org-mode-style
;; visibility cycling for atx- or hash-style headings.  There are two
;; types of visibility cycling: Pressing `S-TAB` cycles globally between
;; the table of contents view (headings only), outline view (top-level
;; headings only), and the full document view.  Pressing `TAB` while the
;; point is at a heading will cycle through levels of visibility for the
;; subtree: completely folded, visible children, and fully visible.
;; Note that mixing hash and underline style headings will give undesired
;; results.

;;; Customization:

;; Although no configuration is *necessary* there are a few things
;; that can be customized.  The `M-x customize-mode` command
;; provides an interface to all of the possible customizations:
;;
;;   * `markdown-command' - the command used to run Markdown (default:
;;     `markdown`).  This variable may be customized to pass
;;     command-line options to your Markdown processor of choice.
;;
;;   * `markdown-command-needs-filename' - set to `t' if
;;     `markdown-command' does not accept standard input (default:
;;     `nil').  When `nil', `markdown-mode' will pass the Markdown
;;     content to `markdown-command' using standard input (`stdin`).
;;     When set to `t', `markdown-mode' will pass the name of the file
;;     as the final command-line argument to `markdown-command'.  Note
;;     that in the latter case, you will only be able to run
;;     `markdown-command' from buffers which are visiting a file.
;;
;;   * `markdown-open-command' - the command used for calling a standalone
;;     Markdown previewer which is capable of opening Markdown source files
;;     directly (default: `nil').  This command will be called
;;     with a single argument, the filename of the current buffer.
;;     A representative program is the Mac app [Marked][], a
;;     live-updating MultiMarkdown previewer which has a command line
;;     utility at `/usr/local/bin/mark`.
;;
;;   * `markdown-hr-strings' - list of strings to use when inserting
;;     horizontal rules.  Different strings will not be distinguished
;;     when converted to HTML--they will all be converted to
;;     `
`--but they may add visual distinction and style to plain
;;     text documents.  To maintain some notion of promotion and
;;     demotion, keep these sorted from largest to smallest.
;;
;;   * `markdown-bold-underscore' - set to a non-nil value to use two
;;     underscores for bold instead of two asterisks (default: `nil').
;;
;;   * `markdown-italic-underscore' - set to a non-nil value to use
;;     underscores for italic instead of asterisks (default: `nil').
;;
;;   * `markdown-indent-function' - the function to use for automatic
;;     indentation (default: `markdown-indent-line').
;;
;;   * `markdown-indent-on-enter' - set to a non-nil value to
;;     automatically indent new lines when the enter key is pressed
;;     (default: `t')
;;
;;   * `markdown-wiki-link-alias-first' - set to a non-nil value to
;;     treat aliased wiki links like `[[link text|PageName]]`
;;     (default: `t').  When set to nil, they will be treated as
;;     `[[PageName|link text]]'.
;;
;;   * `markdown-uri-types' - a list of protocol schemes (e.g., "http")
;;     for URIs that `markdown-mode' should highlight.
;;
;;   * `markdown-enable-math' - syntax highlighting for LaTeX
;;     fragments (default: `nil').  Set this to `t' to turn on math
;;     support by default.  Math support can be toggled later using
;;     the function `markdown-enable-math'."
;;
;;   * `markdown-css-path' - CSS file to link to in XHTML output
;;     (default: `""`).
;;
;;   * `markdown-content-type' - when set to a nonempty string, an
;;     `http-equiv` attribute will be included in the XHTML ``
;;     block (default: `""`).  If needed, the suggested values are
;;     `application/xhtml+xml` or `text/html`.  See also:
;;     `markdown-coding-system'.
;;
;;   * `markdown-coding-system' - used for specifying the character
;;     set identifier in the `http-equiv` attribute when included
;;     (default: `nil').  See `markdown-content-type', which must
;;     be set before this variable has any effect.  When set to `nil',
;;     `buffer-file-coding-system' will be used to automatically
;;     determine the coding system string (falling back to
;;     `iso-8859-1' when unavailable).  Common settings are `utf-8'
;;     and `iso-latin-1'.
;;
;;   * `markdown-xhtml-header-content' - additional content to include
;;     in the XHTML `` block (default: `""`).
;;
;;   * `markdown-xhtml-standalone-regexp' - a regular expression which
;;     `markdown-mode' uses to determine whether the output of
;;     `markdown-command' is a standalone XHTML document or an XHTML
;;     fragment (default: `"^\\(<\\?xml\\| for Debian packaging.
;;   * Conal Elliott  for a font-lock regexp patch.
;;   * Edward O'Connor  for a font-lock regexp fix and
;;     GitHub Flavored Markdown mode (`gfm-mode').
;;   * Greg Bognar  for menus and running
;;     `markdown' with an active region.
;;   * Daniel Burrows  for filing Debian bug #456592.
;;   * Peter S. Galbraith  for maintaining `emacs-goodies-el`.
;;   * Dmitry Dzhus  for undefined reference checking.
;;   * Carsten Dominik  for `org-mode', from which the
;;     visibility cycling functionality was derived, and for a bug fix
;;     related to `orgtbl-mode'.
;;   * Bryan Kyle  for indentation code.
;;   * Ben Voui  for font-lock face customizations.
;;   * Ankit Solanki  for `longlines.el`
;;     compatibility and custom CSS.
;;   * Hilko Bengen  for proper XHTML output.
;;   * Jose A. Ortega Ruiz  for Emacs 23 fixes.
;;   * Nelson Minar  for `html-helper-mode', from which
;;     comment matching functions were derived.
;;   * Alec Resnick  for bug reports.
;;   * Joost Kremers  for footnote-handling
;;     functions, bug reports regarding indentation, and
;;     fixes for byte-compilation warnings.
;;   * Peter Williams  for `fill-paragraph'
;;     enhancements.
;;   * George Ogata  for fixing several
;;     byte-compilation warnings.
;;   * Eric Merritt  for wiki link features.
;;   * Philippe Ivaldi  for XHTML preview
;;     customizations and XHTML export.
;;   * Jeremiah Dodds  for supporting
;;     Markdown processors which do not accept input from stdin.
;;   * Werner Dittmann  for bug reports
;;     regarding the `cl` dependency and `auto-fill-mode' and indentation.
;;   * Scott Pfister  for generalizing the space
;;     substitution character for mapping wiki links to filenames.
;;   * Marcin Kasperski  for a patch to
;;     escape shell commands.
;;   * Christopher J. Madsen  for patches to fix a match
;;     data bug and to prefer `visual-line-mode' in `gfm-mode'.
;;   * Shigeru Fukaya  for better adherence to
;;     Emacs Lisp coding conventions.
;;   * Donald Ephraim Curtis  for fixing the `fill-paragraph'
;;     regexp, refactoring the compilation and preview functions,
;;     heading font-lock generalizations, list renumbering,
;;     and kill ring save.
;;   * Kevin Porter  for wiki link handling in `gfm-mode'.
;;   * Max Penet  and Peter Eisentraut 
;;     for an autoload token for `gfm-mode'.
;;   * Ian Yang  for improving the reference definition regex.
;;   * Akinori Musha  for an imenu index function.
;;   * Michael Sperber  for XEmacs fixes.
;;   * Francois Gannaz  for suggesting charset
;;     declaration in XHTML output.
;;   * Zhenlei Jia  for smart exdention function.
;;   * Matus Goljer  for improved wiki link following
;;     and GFM code block insertion.
;;   * Peter Jones  for link following functions.
;;   * Bryan Fink  for a bug report regarding
;;     externally modified files.
;;   * Vegard Vesterheim  for a bug fix
;;     related to `orgtbl-mode'.
;;   * Makoto Motohashi  for before- and after-
;;     export hooks and unit test improvements.
;;   * Michael Dwyer  for `gfm-mode' underscore regexp.
;;   * Chris Lott  for suggesting reference label
;;     completion.

;;; Bugs:

;; Although markdown-mode is developed and tested primarily using
;; GNU Emacs 24, compatibility with earlier Emacsen is also a
;; priority.
;;
;; If you find any bugs in markdown-mode, please construct a test case
;; or a patch and email me at .

;;; History:

;; markdown-mode was written and is maintained by Jason Blevins.  The
;; first version was released on May 24, 2007.
;;
;;   * 2007-05-24: Version 1.1
;;   * 2007-05-25: Version 1.2
;;   * 2007-06-05: [Version 1.3][]
;;   * 2007-06-29: Version 1.4
;;   * 2007-10-11: [Version 1.5][]
;;   * 2008-06-04: [Version 1.6][]
;;   * 2009-10-01: [Version 1.7][]
;;   * 2011-08-12: [Version 1.8][]
;;   * 2011-08-15: [Version 1.8.1][]
;;   * 2013-01-25: [Version 1.9][]
;;   * 2013-03-18: [Version 2.0][]
;;
;; [Version 1.3]: http://jblevins.org/projects/markdown-mode/rev-1-3
;; [Version 1.5]: http://jblevins.org/projects/markdown-mode/rev-1-5
;; [Version 1.6]: http://jblevins.org/projects/markdown-mode/rev-1-6
;; [Version 1.7]: http://jblevins.org/projects/markdown-mode/rev-1-7
;; [Version 1.8]: http://jblevins.org/projects/markdown-mode/rev-1-8
;; [Version 1.8.1]: http://jblevins.org/projects/markdown-mode/rev-1-8-1
;; [Version 1.9]: http://jblevins.org/projects/markdown-mode/rev-1-9
;; [Version 2.0]: http://jblevins.org/projects/markdown-mode/rev-2-0


;;; Code:

(require 'easymenu)
(require 'outline)
(require 'thingatpt)
(eval-when-compile (require 'cl))


;;; Constants =================================================================

(defconst markdown-mode-version "2.0"
  "Markdown mode version number.")

(defconst markdown-output-buffer-name "*markdown-output*"
  "Name of temporary buffer for markdown command output.")


;;; Global Variables ==========================================================

(defvar markdown-reference-label-history nil
  "History of used reference labels.")


;;; Customizable Variables ====================================================

(defvar markdown-mode-hook nil
  "Hook run when entering Markdown mode.")

(defvar markdown-before-export-hook nil
  "Hook run before running Markdown to export XHTML output.
The hook may modify the buffer, which will be restored to it's
original state after exporting is complete.")

(defvar markdown-after-export-hook nil
  "Hook run after XHTML output has been saved.
Any changes to the output buffer made by this hook will be saved.")

(defgroup markdown nil
  "Major mode for editing text files in Markdown format."
  :prefix "markdown-"
  :group 'wp
  :link '(url-link "http://jblevins.org/projects/markdown-mode/"))

(defcustom markdown-command "markdown"
  "Command to run markdown."
  :group 'markdown
  :type 'string)

(defcustom markdown-command-needs-filename nil
  "Set to non-nil if `markdown-command' does not accept input from stdin.
Instead, it will be passed a filename as the final command line
option.  As a result, you will only be able to run Markdown from
buffers which are visiting a file."
  :group 'markdown
  :type 'boolean)

(defcustom markdown-open-command nil
  "Command used for opening Markdown files directly.
For example, a standalone Markdown previewer.  This command will
be called with a single argument: the filename of the current
buffer."
  :group 'markdown
  :type 'string)

(defcustom markdown-hr-strings
  '("-------------------------------------------------------------------------------"
    "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
    "---------------------------------------"
    "* * * * * * * * * * * * * * * * * * * *"
    "---------"
    "* * * * *")
  "Strings to use when inserting horizontal rules.
The first string in the list will be the default when inserting a
horizontal rule.  Strings should be listed in decreasing order of
prominence (as in headings from level one to six) for use with
promotion and demotion functions."
  :group 'markdown
  :type 'list)

(defcustom markdown-bold-underscore nil
  "Use two underscores for bold instead of two asterisks."
  :group 'markdown
  :type 'boolean)

(defcustom markdown-italic-underscore nil
  "Use underscores for italic instead of asterisks."
  :group 'markdown
  :type 'boolean)

(defcustom markdown-indent-function 'markdown-indent-line
  "Function to use to indent."
  :group 'markdown
  :type 'function)

(defcustom markdown-indent-on-enter t
  "Automatically indent new lines when enter key is pressed.
When this variable is set to t, pressing RET will call
`newline-and-indent'.  When set to nil, define RET to call
`newline' as usual.  In the latter case, you can still use
auto-indentation by pressing \\[newline-and-indent]."
  :group 'markdown
  :type 'boolean)

(defcustom markdown-wiki-link-alias-first t
  "When non-nil, treat aliased wiki links like [[alias text|PageName]].
Otherwise, they will be treated as [[PageName|alias text]]."
  :group 'markdown
  :type 'boolean)

(defcustom markdown-uri-types
  '("acap" "cid" "data" "dav" "fax" "file" "ftp" "gopher" "http" "https"
    "imap" "ldap" "mailto" "mid" "modem" "news" "nfs" "nntp" "pop" "prospero"
    "rtsp" "service" "sip" "tel" "telnet" "tip" "urn" "vemmi" "wais")
  "Link types for syntax highlighting of URIs."
  :group 'markdown
  :type 'list)

(defcustom markdown-enable-math nil
  "Syntax highlighting for inline LaTeX and itex expressions.
Set this to a non-nil value to turn on math support by default.
Math support can be toggled later using `markdown-enable-math'
or \\[markdown-enable-math]."
  :group 'markdown
  :type 'boolean
  :safe 'booleanp)

(defcustom markdown-css-path ""
  "URL of CSS file to link to in the output XHTML."
  :group 'markdown
  :type 'string)

(defcustom markdown-content-type ""
  "Content type string for the http-equiv header in XHTML output.
When set to a non-empty string, insert the http-equiv attribute.
Otherwise, this attribute is omitted."
  :group 'markdown
  :type 'string)

(defcustom markdown-coding-system nil
  "Character set string for the http-equiv header in XHTML output.
Defaults to `buffer-file-coding-system' (and falling back to
`iso-8859-1' when not available).  Common settings are `utf-8'
and `iso-latin-1'.  Use `list-coding-systems' for more choices."
  :group 'markdown
  :type 'coding-system)

(defcustom markdown-xhtml-header-content ""
  "Additional content to include in the XHTML  block."
  :group 'markdown
  :type 'string)

(defcustom markdown-xhtml-standalone-regexp
  "^\\(<\\?xml\\|\\).*$"
  "Regular expression for matching blockquote lines.")

(defconst markdown-regex-line-break
  "[^ \n\t][ \t]*\\(  \\)$"
  "Regular expression for matching line breaks.")

(defconst markdown-regex-wiki-link
  "\\(?:^\\|[^\\]\\)\\(\\[\\[\\([^]|]+\\)\\(|\\([^]]+\\)\\)?\\]\\]\\)"
  "Regular expression for matching wiki links.
This matches typical bracketed [[WikiLinks]] as well as 'aliased'
wiki links of the form [[PageName|link text]].  In this regular
expression, group 1 matches the entire link, including square
brackets, group 2 matches the first component of the wiki link
and group 4 matches the second component, after the pipe, when
present.  The meanings of the first and second components depend
on the value of `markdown-wiki-link-alias-first'.")

(defconst markdown-regex-uri
  (concat (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;() ]+")
  "Regular expression for matching inline URIs.")

(defconst markdown-regex-angle-uri
  (concat "\\(<\\)\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;()]+\\)\\(>\\)")
  "Regular expression for matching inline URIs in angle brackets.")

(defconst markdown-regex-email
  "<\\(\\(\\sw\\|\\s_\\|\\s.\\)+@\\(\\sw\\|\\s_\\|\\s.\\)+\\)>"
  "Regular expression for matching inline email addresses.")

(defconst markdown-regex-link-generic
  (concat "\\(?:" markdown-regex-wiki-link
          "\\|" markdown-regex-link-inline
          "\\|" markdown-regex-link-reference
          "\\|" markdown-regex-angle-uri "\\)")
  "Regular expression for matching any recognized link.")

(defconst markdown-regex-block-separator
  "\\(\\`\\|\\(\n[ \t]*\n\\)[^\n \t]\\)"
  "Regular expression for matching block boundaries.")

(defconst markdown-regex-math-inline
  "\\(^\\|[^\\]\\)\\(\\$\\($\\([^\\$]\\|\\\\.\\)*\\$\\|\\([^\\$]\\|\\\\.\\)*\\)\\$\\)"
  "Regular expression for itex $..$ or $$..$$ math mode expressions.")

(defconst markdown-regex-math-display
  "^\\\\\\[\\(.\\|\n\\)*?\\\\\\]$"
  "Regular expression for itex \[..\] display mode expressions.")

(defconst markdown-regex-multimarkdown-metadata
  "^\\([[:alpha:]][[:alpha:] _-]*?\\):[ \t]*\\(.*\\)$"
  "Regular expression for matching MultiMarkdown metadata.")

(defconst markdown-regex-pandoc-metadata
  "^\\(%\\)[ \t]*\\(.*\\)$"
  "Regular expression for matching Pandoc metadata.")

(defvar markdown-mode-font-lock-keywords-basic
  (list
   (cons 'markdown-match-pre-blocks '((0 markdown-pre-face)))
   (cons 'markdown-match-fenced-code-blocks '((0 markdown-pre-face)))
   (cons markdown-regex-blockquote 'markdown-blockquote-face)
   (cons markdown-regex-header-1-setext '((1 markdown-header-face-1)
                                          (2 markdown-header-rule-face)))
   (cons markdown-regex-header-2-setext '((1 markdown-header-face-2)
                                          (2 markdown-header-rule-face)))
   (cons markdown-regex-header-6-atx '((1 markdown-header-delimiter-face)
                                       (2 markdown-header-face-6)
                                       (3 markdown-header-delimiter-face)))
   (cons markdown-regex-header-5-atx '((1 markdown-header-delimiter-face)
                                       (2 markdown-header-face-5)
                                       (3 markdown-header-delimiter-face)))
   (cons markdown-regex-header-4-atx '((1 markdown-header-delimiter-face)
                                       (2 markdown-header-face-4)
                                       (3 markdown-header-delimiter-face)))
   (cons markdown-regex-header-3-atx '((1 markdown-header-delimiter-face)
                                       (2 markdown-header-face-3)
                                       (3 markdown-header-delimiter-face)))
   (cons markdown-regex-header-2-atx '((1 markdown-header-delimiter-face)
                                       (2 markdown-header-face-2)
                                       (3 markdown-header-delimiter-face)))
   (cons markdown-regex-header-1-atx '((1 markdown-header-delimiter-face)
                                       (2 markdown-header-face-1)
                                       (3 markdown-header-delimiter-face)))
   (cons 'markdown-match-multimarkdown-metadata '((1 markdown-metadata-key-face)
                                                  (2 markdown-metadata-value-face)))
   (cons 'markdown-match-pandoc-metadata '((1 markdown-comment-face)
                                           (2 markdown-metadata-value-face)))
   (cons markdown-regex-hr 'markdown-header-face)
   (cons 'markdown-match-comments '((0 markdown-comment-face)))
   (cons 'markdown-match-code '((0 markdown-inline-code-face)))
   (cons markdown-regex-angle-uri 'markdown-link-face)
   (cons markdown-regex-uri 'markdown-link-face)
   (cons markdown-regex-email 'markdown-link-face)
   (cons markdown-regex-list '(2 markdown-list-face))
   (cons markdown-regex-footnote 'markdown-footnote-face)
   (cons markdown-regex-link-inline '((1 markdown-link-face t t)
                                      (2 markdown-link-face t)
                                      (4 markdown-url-face t)
                                      (6 markdown-link-title-face t t)))
   (cons markdown-regex-link-reference '((1 markdown-link-face t t)
                                         (2 markdown-link-face t)
                                         (4 markdown-reference-face t)))
   (cons markdown-regex-reference-definition '((1 markdown-reference-face t)
                                               (2 markdown-url-face t)
                                               (3 markdown-link-title-face t)))
   (cons markdown-regex-bold '(2 markdown-bold-face))
   (cons markdown-regex-line-break '(1 markdown-line-break-face prepend))
   )
  "Syntax highlighting for Markdown files.")

(defvar markdown-mode-font-lock-keywords-core
  (list
   (cons markdown-regex-italic '(2 markdown-italic-face))
   )
  "Additional syntax highlighting for Markdown files.
Includes features which are overridden by some variants.")

(defconst markdown-mode-font-lock-keywords-math
  (list
   ;; Math mode $..$ or $$..$$
   (cons markdown-regex-math-inline '(2 markdown-math-face))
   ;; Display mode equations with brackets: \[ \]
   (cons markdown-regex-math-display 'markdown-math-face)
   ;; Equation reference (eq:foo)
   (cons "(eq:[[:alnum:]:_]+)" 'markdown-reference-face)
   ;; Equation reference \eqref{foo}
   (cons "\\\\eqref{[[:alnum:]:_]+}" 'markdown-reference-face))
  "Syntax highlighting for LaTeX and itex fragments.")

(defvar markdown-mode-font-lock-keywords nil
  "Default highlighting expressions for Markdown mode.
This variable is defined as a buffer-local variable for dynamic
extension support.")

;; Footnotes
(defvar markdown-footnote-counter 0
  "Counter for footnote numbers.")
(make-variable-buffer-local 'markdown-footnote-counter)

(defconst markdown-footnote-chars
  "[[:alnum:]-]"
  "Regular expression maching any character that is allowed in a footnote identifier.")


;;; Compatibility =============================================================

(defun markdown-replace-regexp-in-string (regexp rep string)
  "Replace ocurrences of REGEXP with REP in STRING.
This is a compatibility wrapper to provide `replace-regexp-in-string'
in XEmacs 21."
  (if (featurep 'xemacs)
      (replace-in-string string regexp rep)
    (replace-regexp-in-string regexp rep string)))

;; `markdown-use-region-p' is a compatibility function which checks
;; for an active region, with fallbacks for older Emacsen and XEmacs.
(eval-and-compile
  (cond
   ;; Emacs 23 and newer
   ((fboundp 'use-region-p)
    (defalias 'markdown-use-region-p 'use-region-p))
   ;; Older Emacsen
   ((and (boundp 'transient-mark-mode) (boundp 'mark-active))
    (defun markdown-use-region-p ()
      "Compatibility wrapper to provide `use-region-p'."
      (and transient-mark-mode mark-active)))
   ;; XEmacs
   ((fboundp 'region-active-p)
    (defalias 'markdown-use-region-p 'region-active-p))))

(defun markdown-use-buttons-p ()
  "Determine whether this Emacs supports buttons."
  (or (featurep 'button) (locate-library "button")))


;;; Markdown Parsing Functions ================================================

(defun markdown-cur-line-blank-p ()
  "Return t if the current line is blank and nil otherwise."
  (save-excursion
    (beginning-of-line)
    (re-search-forward "^\\s *$" (line-end-position) t)))

(defun markdown-prev-line-blank-p ()
  "Return t if the previous line is blank and nil otherwise.
If we are at the first line, then consider the previous line to be blank."
  (or (= (line-beginning-position) (point-min))
      (save-excursion
        (forward-line -1)
        (markdown-cur-line-blank-p))))

(defun markdown-next-line-blank-p ()
  "Return t if the next line is blank and nil otherwise.
If we are at the last line, then consider the next line to be blank."
  (or (= (line-end-position) (point-max))
      (save-excursion
        (forward-line 1)
        (markdown-cur-line-blank-p))))

(defun markdown-prev-line-indent-p ()
  "Return t if the previous line is indented and nil otherwise."
  (save-excursion
    (forward-line -1)
    (goto-char (line-beginning-position))
    (if (re-search-forward "^\\s " (line-end-position) t) t)))

(defun markdown-cur-line-indent ()
  "Return the number of leading whitespace characters in the current line."
  (save-match-data
    (save-excursion
      (goto-char (line-beginning-position))
      (re-search-forward "^[ \t]+" (line-end-position) t)
      (current-column))))

(defun markdown-prev-line-indent ()
  "Return the number of leading whitespace characters in the previous line."
  (save-excursion
    (forward-line -1)
    (markdown-cur-line-indent)))

(defun markdown-next-line-indent ()
  "Return the number of leading whitespace characters in the next line."
  (save-excursion
    (forward-line 1)
    (markdown-cur-line-indent)))

(defun markdown-cur-non-list-indent ()
  "Return beginning position of list item text (not including the list marker).
Return nil if the current line is not the beginning of a list item."
  (save-match-data
    (save-excursion
      (beginning-of-line)
      (when (re-search-forward markdown-regex-list (line-end-position) t)
        (current-column)))))

(defun markdown-prev-non-list-indent ()
  "Return position of the first non-list-marker on the previous line."
  (save-excursion
    (forward-line -1)
    (markdown-cur-non-list-indent)))

(defun markdown-new-baseline-p ()
  "Determine if the current line begins a new baseline level."
  (save-excursion
    (beginning-of-line)
    (save-match-data
      (or (looking-at markdown-regex-header)
          (looking-at markdown-regex-hr)
          (and (null (markdown-cur-non-list-indent))
               (= (markdown-cur-line-indent) 0)
               (markdown-prev-line-blank-p))))))

(defun markdown-search-backward-baseline ()
  "Search backward baseline point with no indentation and not a list item."
  (end-of-line)
  (let (stop)
    (while (not (or stop (bobp)))
      (re-search-backward markdown-regex-block-separator nil t)
      (when (match-end 2)
        (goto-char (match-end 2))
        (cond
         ((markdown-new-baseline-p)
          (setq stop t))
         ((looking-at markdown-regex-list)
          (setq stop nil))
         (t (setq stop t)))))))

(defun markdown-update-list-levels (marker indent levels)
  "Update list levels given list MARKER, block INDENT, and current LEVELS.
Here, MARKER is a string representing the type of list, INDENT is an integer
giving the indentation, in spaces, of the current block, and LEVELS is a
list of the indentation levels of parent list items.  When LEVELS is nil,
it means we are at baseline (not inside of a nested list)."
  (cond
   ;; New list item at baseline.
   ((and marker (null levels))
    (setq levels (list indent)))
   ;; List item with greater indentation (four or more spaces).
   ;; Increase list level.
   ((and marker (>= indent (+ (car levels) 4)))
    (setq levels (cons indent levels)))
   ;; List item with greater or equal indentation (less than four spaces).
   ;; Do not increase list level.
   ((and marker (>= indent (car levels)))
    levels)
   ;; Lesser indentation level.
   ;; Pop appropriate number of elements off LEVELS list (e.g., lesser
   ;; indentation could move back more than one list level).  Note
   ;; that this block need not be the beginning of list item.
   ((< indent (car levels))
    (while (and (> (length levels) 1)
                (< indent (+ (cadr levels) 4)))
      (setq levels (cdr levels)))
    levels)
   ;; Otherwise, do nothing.
   (t levels)))

(defun markdown-calculate-list-levels ()
  "Calculate list levels at point.
Return a list of the form (n1 n2 n3 ...) where n1 is the
indentation of the deepest nested list item in the branch of
the list at the point, n2 is the indentation of the parent
list item, and so on.  The depth of the list item is therefore
the length of the returned list.  If the point is not at or
immediately  after a list item, return nil."
  (save-excursion
    (let ((first (point)) levels indent pre-regexp)
      ;; Find a baseline point with zero list indentation
      (markdown-search-backward-baseline)
      ;; Search for all list items between baseline and LOC
      (while (and (< (point) first)
                  (re-search-forward markdown-regex-list first t))
        (setq pre-regexp (format "^\\(    \\|\t\\)\\{%d\\}" (1+ (length levels))))
        (beginning-of-line)
        (cond
         ;; Make sure this is not a header or hr
         ((markdown-new-baseline-p) (setq levels nil))
         ;; Make sure this is not a line from a pre block
         ((looking-at pre-regexp))
         ;; If not, then update levels
         (t
          (setq indent (markdown-cur-line-indent))
          (setq levels (markdown-update-list-levels (match-string 2)
                                                    indent levels))))
        (end-of-line))
      levels)))

(defun markdown-prev-list-item (level)
  "Search backward from point for a list item with indentation LEVEL.
Set point to the beginning of the item, and return point, or nil
upon failure."
  (let (bounds indent prev)
    (setq prev (point))
    (forward-line -1)
    (setq indent (markdown-cur-line-indent))
    (while
        (cond
         ;; Stop at beginning of buffer
         ((bobp) (setq prev nil))
         ;; Continue if current line is blank
         ((markdown-cur-line-blank-p) t)
         ;; List item
         ((and (looking-at markdown-regex-list)
               (setq bounds (markdown-cur-list-item-bounds)))
          (cond
           ;; Continue at item with greater indentation
           ((> (nth 3 bounds) level) t)
           ;; Stop and return point at item of equal indentation
           ((= (nth 3 bounds) level)
            (setq prev (point))
            nil)
           ;; Stop and return nil at item with lesser indentation
           ((< (nth 3 bounds) level)
            (setq prev nil)
            nil)))
         ;; Continue while indentation is the same or greater
         ((>= indent level) t)
         ;; Stop if current indentation is less than list item
         ;; and the next is blank
         ((and (< indent level)
               (markdown-next-line-blank-p))
          (setq prev nil))
         ;; Stop at a header
         ((looking-at markdown-regex-header) (setq prev nil))
         ;; Stop at a horizontal rule
         ((looking-at markdown-regex-hr) (setq prev nil))
         ;; Otherwise, continue.
         (t t))
      (forward-line -1)
      (setq indent (markdown-cur-line-indent)))
    prev))

(defun markdown-next-list-item (level)
  "Search forward from point for the next list item with indentation LEVEL.
Set point to the beginning of the item, and return point, or nil
upon failure."
  (let (bounds indent prev next)
    (setq next (point))
    (forward-line)
    (setq indent (markdown-cur-line-indent))
    (while
        (cond
         ;; Stop at end of the buffer.
         ((eobp) (setq prev nil))
         ;; Continue if the current line is blank
         ((markdown-cur-line-blank-p) t)
         ;; List item
         ((and (looking-at markdown-regex-list)
               (setq bounds (markdown-cur-list-item-bounds)))
          (cond
           ;; Continue at item with greater indentation
           ((> (nth 3 bounds) level) t)
           ;; Stop and return point at item of equal indentation
           ((= (nth 3 bounds) level)
            (setq next (point))
            nil)
           ;; Stop and return nil at item with lesser indentation
           ((< (nth 3 bounds) level)
            (setq next nil)
            nil)))
         ;; Continue while indentation is the same or greater
         ((>= indent level) t)
         ;; Stop if current indentation is less than list item
         ;; and the previous line was blank.
         ((and (< indent level)
               (markdown-prev-line-blank-p))
          (setq next nil))
         ;; Stop at a header
         ((looking-at markdown-regex-header) (setq next nil))
         ;; Stop at a horizontal rule
         ((looking-at markdown-regex-hr) (setq next nil))
         ;; Otherwise, continue.
         (t t))
      (forward-line)
      (setq indent (markdown-cur-line-indent)))
    next))

(defun markdown-cur-list-item-end (level)
  "Move to the end of the current list item with nonlist indentation LEVEL.
If the point is not in a list item, do nothing."
  (let (indent)
    (forward-line)
    (setq indent (markdown-cur-line-indent))
    (while
        (cond
         ;; Stop at end of the buffer.
         ((eobp) nil)
         ;; Continue if the current line is blank
         ((markdown-cur-line-blank-p) t)
         ;; Continue while indentation is the same or greater
         ((>= indent level) t)
         ;; Stop if current indentation is less than list item
         ;; and the previous line was blank.
         ((and (< indent level)
               (markdown-prev-line-blank-p))
          nil)
         ;; Stop at a new list item of the same or lesser indentation
         ((looking-at markdown-regex-list) nil)
         ;; Stop at a header
         ((looking-at markdown-regex-header) nil)
         ;; Stop at a horizontal rule
         ((looking-at markdown-regex-hr) nil)
         ;; Otherwise, continue.
         (t t))
      (forward-line)
      (setq indent (markdown-cur-line-indent)))
    ;; Don't skip over whitespace for empty list items (marker and
    ;; whitespace only), just move to end of whitespace.
    (if (looking-back (concat markdown-regex-list "\\s-*"))
          (goto-char (match-end 3))
      (skip-syntax-backward "-"))))

(defun markdown-cur-list-item-bounds ()
  "Return bounds and indentation of the current list item.
Return a list of the form (begin end indent nonlist-indent marker).
If the point is not inside a list item, return nil.
Leave match data intact for `markdown-regex-list'."
  (let (cur prev-begin prev-end indent nonlist-indent marker)
    ;; Store current location
    (setq cur (point))
    ;; Verify that cur is between beginning and end of item
    (save-excursion
      (end-of-line)
      (when (re-search-backward markdown-regex-list nil t)
        (setq prev-begin (match-beginning 0))
        (setq indent (length (match-string 1)))
        (setq nonlist-indent (length (match-string 0)))
        (setq marker (concat (match-string 2) (match-string 3)))
        (save-match-data
          (markdown-cur-list-item-end nonlist-indent)
          (setq prev-end (point)))
        (when (and (>= cur prev-begin)
                   (<= cur prev-end)
                   nonlist-indent)
          (list prev-begin prev-end indent nonlist-indent marker))))))

(defun markdown-bounds-of-thing-at-point (thing)
  "Call `bounds-of-thing-at-point' for THING with slight modifications.
Does not include trailing newlines when THING is 'line.  Handles the
end of buffer case by setting both endpoints equal to the value of
`point-max', since an empty region will trigger empty markup insertion.
Return bounds of form (beg . end) if THING is found, or nil otherwise."
  (let* ((bounds (bounds-of-thing-at-point thing))
         (a (car bounds))
         (b (cdr bounds)))
    (when bounds
      (when (eq thing 'line)
        (cond ((and (eobp) (markdown-cur-line-blank-p))
               (setq a b))
              ((char-equal (char-before b) ?\^J)
               (setq b (1- b)))))
      (cons a b))))

(defun markdown-reference-definition (reference)
  "Find out whether Markdown REFERENCE is defined.
REFERENCE should include the square brackets, like [this].
When REFERENCE is defined, return a list of the form (text start end)
containing the definition text itself followed by the start and end
locations of the text.  Otherwise, return nil.
Leave match data for `markdown-regex-reference-definition'
intact additional processing."
  (let ((reference (downcase reference)))
    (save-excursion
      (goto-char (point-min))
      (catch 'found
        (while (re-search-forward markdown-regex-reference-definition nil t)
          (when (string= reference (downcase (match-string-no-properties 1)))
            (throw 'found
                   (list (match-string-no-properties 2)
                         (match-beginning 2) (match-end 2)))))))))

(defun markdown-get-defined-references ()
  "Return a list of all defined reference labels (including square brackets)."
  (save-excursion
    (goto-char (point-min))
    (let (refs)
      (while (re-search-forward markdown-regex-reference-definition nil t)
        (let ((target (match-string-no-properties 1)))
          (add-to-list 'refs target t)))
      refs)))

(defun markdown-code-at-point-p ()
  "Return non-nil if the point is at an inline code fragment.
Return nil otherwise.  Set match data according to
`markdown-match-code' upon success.
This function searches the block for a code fragment that
contains the point using `markdown-match-code'.  We do this
because `thing-at-point-looking-at' does not work reliably with
`markdown-regex-code'."
  (interactive)
  (save-excursion
    (let ((old-point (point))
          (end-of-block (progn (markdown-end-of-block) (point)))
          found)
      (markdown-beginning-of-block)
      (while (and (markdown-match-code end-of-block)
                  (setq found t)
                  (< (match-end 0) old-point)))
      (and found                              ; matched something
           (<= (match-beginning 0) old-point) ; match contains old-point
           (>= (match-end 0) old-point)))))


;;; Markdown Font Lock Matching Functions =====================================

(defun markdown-match-comments (last)
  "Match HTML comments from the point to LAST."
  (cond ((search-forward "")
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip " not requiring
;;   a fold name.
;; - (folding-skip-folds): >>feature not not enabled<<
;;   2.69 Do not require trailing " " any more.'
;;   (folding-tidy-inside): >>feature not not enabled<<
;;   2.69 Do not require trailing " " any more.
;; - (folding-install): 2.69 Fixed indentation.
;; - (folding-mark-look-at): 2.69 The "em" missed "*" and thus pressing
;;   mouse-3 at the end-fold didn't collapse the whole fold.
;;
;; Jan  12  1999  20.4             [jari 2.69]
;;   (folding-bind-default-mouse): 2.68
;;   XEmacs and Emacs Mouse binding was different. Now use common
;;   bindings: The S-mouse-2 was superfluous, because mouse-3 already
;;   did that, so the binding was removed.
;;   mouse-3     folding-mouse-context-sensitive
;;   S-mouse-2   folding-hide-current-entry
;;   C-S-mouse-2 folding-mouse-pick-move
;;
;;;; Jan  09  1999  20.4             [jari 2.67-2.68]
;; - (folding-event-posn): 2.66 Hide `event-start' From XEmacs
;;   (byte compile silencer)
;;
;; Jan  07  1999  20.4             [jari 2.65-2.66]
;; - The Folding begin and AND mark was not case sensitive;
;;   that's why a latex styles "\B" and "\endB" fold marks couldn't
;;   be used. Added relevant `case-fold-search' settings. Not tested
;;   very well, though.
;; - Added standard "turn-on" "turn-off" functions.
;; - (folding-whole-buffer): 2.65 Better
;;   Error message. Show used folding-mark on error.
;; - (folding-skip-folds): 2.65 Moved docs in function.
;; - (turn-off-folding-mode): 2.65 New.
;; - (turn-on-folding-mode): 2.65 New.
;; - (folding-mark-look-at): 2.65 `case-fold-search'
;; - (folding-next-visible-heading): 2.65 `case-fold-search'
;; - (folding-find-folding-mark): 2.65 `case-fold-search'
;; - (folding-pick-move): 2.65 `case-fold-search'
;; - (folding-skip-folds): 2.65 `case-fold-search'
;; - (folding-tidy-inside): 2.65 `case-fold-search'
;; - (folding-convert-to-major-folds): 2.65 `case-fold-search'
;;
;;  Jan  04  1999  20.4             [jari 2.62-2.64]
;; - (folding-set-local-variables): 2.61 New. Now it is possible to
;;   change the folding marks dynamically.
;; - (folding-mode): 2.61 Call `folding-set-local-variables'
;;   (folding-mode-marks-alist): 2.61 mention
;; - `folding-set-local-variables'
;;   Added documentation section: "Example: AucTex setup"
;; - NT Emacs fix wrapped inside `eval-and-compile'. hs-discard-overlays
;;   are now hidden from byte compiler (since the code is not
;;   executed anyway)
;;
;; May  24  1999  19.34             [jari 2.59-2.61]
;; - New function `folding-all-comment-blocks-in-region'. Requested by
;;   Uwe Brauer . Bound under "/" key.
;; - (folding-all-comment-blocks-in-region):
;;   Check non-whitespace `comment-end'. Added `matlab-mode' to
;;   fold list
;; - (folding-event-posn): 2.63 Got rid of the XEmacs/Emacs
;;   posn-/event- byte compiler warnings
;; - (folding-mouse-call-original): 2.63 Got rid of the XEmacs
;;   `event-button' byte compiler warning.
;;
;; Apr  15  1999  19.34             [jari 2.57]
;; - (folding-mouse-call-original): Samuel Mikes
;;    reported that the `concat' function was
;;   used to add an integer to "button" event.  Applied patch to use
;;   `format' instead.
;;
;; Mar  03  1999  19.34             [andersl]
;;  - (folding-install): had extra paren. Removed.
;;
;; Feb  22  1999  19.34             [jari 2.56]
;;  - folding-install):
;;    Check if `folding-mode-prefix-map' is nil and call
;;
;; Feb  19  1999  19.34             [jari 2.55]
;;  - (folding-mode-hook-no-re):
;;    Renamed to `folding-mode-hook-no-regexp'
;;  - (fold-inside-mode-name): Renames to `folding-inside-mode-name'
;;    (fold-mode-string): Renamed to `folding-mode-string'
;;  - Renamed all `fold-' prefixes to `folding-'
;;  - Rewrote chapter `Example: personal setup'
;;
;; Jan  01  1999  19.34             [jari 2.54]
;; - Byte compiler error fix: (folding-bind-outline-compatible-keys):
;;   'folding-show-all lacked the quote.
;;
;; Dec  30  1998  19.34             [jari 2.53]
;; - Jesper Pedersen  reported bug that hiding
;;   subtree was broken. This turned out to be a bigger problem in fold
;;   handling in general. This release has big relatively big error
;;   fixes.
;; - Many of the folding functions were also renamed to mimic Emacs 20.3
;;   allout.el names. Outline keybindings were rewritten too.
;; - folding.el (folding-mouse-yank-at-point): Renamed from
;;   `folding-mouse-operate-at-point'. The name is similar to Emacs
;;   standard variable name. The default value changed from nil --> t
;;   according to suggestion by Jesper Pedersen 
;;   Message "Info, Ignore [X]Emacs specific..." is now displayed only
;;   while byte compiling file.
;;   (folding-bind-outline-compatible-keys):
;;   Checked the Emacs 20.3 allout.el outline bindings and made
;;   folding mimic them
;;   (folding-show-subtree): Renamed to `folding-show-current-subtree'
;;   according to allout.el
;;   (folding-hide-subtree): Renamed to `folding-hide-current-subtree'
;;   according to allout.el
;;   (folding-enter): Renamed to `folding-shift-in'
;;   according to allout.el
;;   (folding-exit): Renamed to `folding-shift-out'
;;   according to allout.el
;;   (folding-move-up): Renamed to `folding-previous-visible-heading'
;;   according to allout.el
;;   (folding-move): Renamed to `folding-next-visible-heading'
;;   according to allout.el
;;   (folding-top-level): Renamed to `folding-show-all'
;;   according to allout.el
;;   (folding-show): Renamed to `folding-show-current-entry'
;;   according to allout.el
;;   (folding-hide): Renamed to `folding-hide-current-entry'
;;   according to allout.el
;;   (folding-region-open-close): While loop rewritten so that if user
;;   is already on a fold mark, then close current fold. This also
;;   fixed the show/hide subtree problem.
;;   (folding-hide-current-subtree): If use hide subtree that only had
;;   one fold, then calling this function caused error. The reason was
;;   error in `folding-pick-move' (folding-pick-move): Test that
;;   `moved' variable is integer and only then move point. This is the
;;   status indicator from `folding-find-folding-mark'
;;   (folding-find-folding-mark): Fixed. mistakenly moved point when
;;   checking TOP level marker, status 11. the point was permanently
;;   moved to point-min.
;;
;; Dec  29  1998  19.34             [jari 2.51]
;; - Jesper Pedersen  reported that prefix key
;;   cannot take vector notation [(key)]. This required changing the way
;;   how folding maps the keys. Now uses intermediate keymap
;;   `folding-mode-prefix-map'
;; - `folding-kbd' is new.
;; - `folding-mode' function description has better layout.
;; - `folding-get-mode-marks' is now defsubst.
;;
;; Dec  13  1998  19.34             [jari 2.49-2.50]
;; - Gleb Arshinov  reported that the XEmacs 21.0
;;   `concat' function won't accept integer argument any more and
;;   provided patch for `folding-set-mode-line'.
;;
;; Nov  28  1998  19.34             [jari 2.49-2.50]
;; - Gleb Arshinov  reported that the
;;   zmacs-region-stays must not be set globally but in the functions
;;   that need it. He tested the change on tested on XEmacs 21.0 beta
;;   and FSF Emacs 19.34.6 on NT and sent a patch . Thank you.
;; - (folding-preserve-active-region): New macro to set
;;   `zmacs-region-stays' to t in XEmacs.
;; - (folding-forward-char): Use `folding-preserve-active-region'
;; - (folding-backward-char): Use `folding-preserve-active-region'
;; - (folding-end-of-line):  Use `folding-preserve-active-region'
;; - (folding-isearch-general): Variables `is-fold' and
;;   `is narrowed' removed, because they were not used. (Byte
;;   Compilation fix)
;; - Later: interestingly using `defmacro'
;;   folding-preserve-active-region does not work in XEmacs 21.0 beta,
;;   but `defsubst' does. Reported and corrected by Gleb.
;;
;; Oct  22  1998  19.34             [jari 2.47-2.48]
;; - NT Emacs has had long time a bug where it strips away ^M when
;;   closed fold is copied to kill ring. When pasted, then ^M are
;;   gone. This cover NT Emacs releases 19.34 - 20.3. Bug report has
;;   been filed.
;; - to cope with the situation I added new advice functions that
;;   get instantiated only for these versions of NT Emacs. See
;;   `kill-new' and `current-kill'
;;
;; Oct  21  1998  19.34             [jari 2.46]
;; - `folding-isearch-general' now enters folds as usual with isearch.
;;   The only test needed was to check `quit-isearch' before calling
;;   `folding-goto-char', because the narrow case was already taken
;;   cared of in the condition case.
;;
;; Oct  19  1998  19.34             [jari 2.44]
;; -  1998-10-19 Uwe Brauer  reported that
;;    In Netscape version > 4 the {{{ marks cannot be used. For IE they
;;    were fine, but not for Netscape. Some bug there.
;;    --> Marks changed to [[[ ]]]
;;
;; Oct  5  1998  19.34             [jari 2.43]
;; - The "_p" flag does not exist in Emacs 19.34, so the previous patch
;;   was removed.  (Greg Klanderman) suggested using
;;   `zmacs-region-stays'. Added to the beginning of file.
;; - todo: folding does not seem to open folds any more with Isearch.
;;
;; Oct  5  1998  19.34             [jari 2.42]
;; - Gleb Arshinov  reported (and supplied patch):
;;   I am using the latest beta of folding.el with XEmacs 21.0 "Finnish
;;   Landrace" [Lucid] (i386-pc-win32) (same bug is present with folding.el
;;   included with XEmacs). Being a big fan of zmacs-region, I was
;;   disappointed to find that folding mode caused my usual way of
;;   selecting regions (e.g. to select a line C-space, C-a, C-e) to break
;;   :( I discovered that the following 3 functions would unset my mark.
;;   Upon reading some documentation, this seems to be caused by an
;;   argument to interactive used by these functions. With the following
;;   tiny patch, the undesirable behaviour is gone.
;; - Patch was applied as is. Function affected:
;;   `folding-forward-char' `folding-backward-char'
;;   `folding-end-of-line'. Interactive spec changed from "p" to "_p"
;;
;; Sep 28  1998  19.34             [jari 2.41]
;; - Wrote section "folding-whole-buffer doesn't fold whole buffer" to
;;   Problems topic. Fixed some indentation in documentation so that
;;   command  ripdoc.pl folding.el | t2html.pl --simple > folding.html
;;   works properly.
;;
;; Sep 24  1998  19.34             [jari 2.40]
;; - Stephen Smith  wished that the
;;   `folding-comment-fold' should handle modes that have comment-start
;;   and comment-end too. That lead to rewriting the comment function so
;;   that it can be adapted to new modes.
;; - `folding-pick-move' didn't work in C-mode. Fixed.
;;    (folding-find-folding-mark):
;;    m and re must be protected with `regexp-quote'. This
;;    corrected error eg. in C-mode where `folding-pick-move'
;;    didn't move at all.
;;    (folding-comment-fold): Added support for major modes that
;;    have `comment-start' and `comment-end'. Use
;;    `folding-comment-folding-table'
;;    (folding-comment-c-mode): New.
;;    (folding-uncomment-c-mode): New.
;;    (folding-comment-folding-table): New. To adapt to any major-mode.
;;    (folding-uncomment-mode-generic): New.
;;    (folding-comment-mode-generic): New.
;;
;; Aug 08  1998  19.34             [jari 2.39]
;; - Andrew Maccormack  reported that the
;;   `em' end marker that was defined in the `let' should also have
;;   `[ \t\n]' which is in par with the `bm'. This way fold markers do
;;   not need to be parked to the left any more.
;;
;; Jun 05  1998  19.34             [jari 2.37-2.38]
;; - Alf-Ivar Holm  send functions
;;   `folding-toggle-enter-exit' and `folding-toggle-show-hide' which
;;   were integrated. Alf also suggested that Fold marks should now
;;   necessarily be located at the beginning of line, but allow spaces
;;   at front. The patch was applied to `folding-mark-look-at'
;;
;; Mar 17  1998  19.34             [Anders]
;; - Anders: This patch fixes one problem that was reported in the
;;   beginning of May by Ryszard Kubiak .
;; - Finally, I think that I have gotten mouse-context-sensitive
;;   right.  Now, when you click on a fold that fold rather than the
;;   one the cursor is on is used, while still not breaking commands
;;   like `mouse-save-then-kill' which assumes that the point hasn't
;;   been moved.
;; - Jari: Added topic "Fold must have a label" to the Problem section.
;;   as reported by Solofo Ramangalahy 
;; - 1998-05-04 Ryszard Kubiak  reported: I am
;;   just curious if it is possible to make Emacs' cursor
;;   automatically follow a mouse-click on the {{{ and }}} lines. I
;;   mean by this that a [S-mouse-3] (as defined in my settings below
;;   --- I keep not liking overloading [mouse-3]) first moves the
;;   cursor to where the click happened and then hides or shows a
;;   folded area. I presume that i can write a two-lines long
;;   interactive function to do this. Still, may be this kind of mouse
;;   behaviour is already available.
;;
;; Mar 17  1998  19.34             [Jari 2.34-2.35]
;; - Added "Example: choosing different fold marks for mode"
;; - corrected `my-folding-text-mode-setup' example.
;;
;; Mar 10  1998  19.34             [Jari 2.32-2.33]
;; - [Anders] responds to mouse-3 handling problem: I have found the
;;   cause of the problem, and I have a suggestion for a fix.
;;
;;   The problem is caused by two things:
;;    * The "mouse-save-then-kill" checks that the previous command also
;;      was "mouse-save-then-kill".
;;
;;    * The second (more severe) problem is that
;;     "folding-mouse-context-sensitive" sets the point to the
;;     location of the click, effectively making
;;     "mouse-save-then-kill" mark the area between the point and the
;;     point! (This is why no region appears.)
;;
;;   The first problem can be easily fixed by setting "this-command"
;;   in "folding-mouse-call-original":
;;
;; -  Now the good old mouse-3 binding is back again.
;; - (folding-mouse-context-sensitive): Added `save-excursion' as
;;   Anders suggested before setting `state'.
;;   (folding-mouse-call-original): commented out experimental code and
;;   used (setq this-command orig-func) as Anders suggested.
;;
;; Mar 10  1998  19.34             [Jari 2.31]
;; - (folding-act): Added `event' to `folding-behave-table' calls.
;;   Input argument takes now `event' too
;; - (folding-mouse-context-sensitive): Added argument `event'
;; - (folding-mouse-call-original): Added  (this-command orig-func)
;;   when calling original command.
;; - (folding-bind-default-mouse): Changed mouse bindings. The
;;   button-3 can't be mapped by folding, because folding is unable to
;;   call the original function `mouse-save-then-kill'. Passing simple
;;   element to `mouse-save-then-kill' won't do the job. Eg if I
;;   (clicked mouse-1) moved mouse pointer to place X and pressed
;;   mouse-3, the area was not highlighted in folding mode. If folding
;;   mode was off the are was highlighted. I traced the
;;   `folding-mouse-call-original' and it was passing exactly the same
;;   event as without folding mode. I have no clue what to do about
;;   it...That's why I removed default mouse-3 binding and left it to
;;   emacs. This bug was reported by Ryszard Kubiak"
;;   
;;
;; Feb 12  1998  19.34             [Jari 2.30]
;; - (html-mode): New mode added to `folding-mode-marks-alist'
;; - (folding-get-mode-marks): Rewritten, now return 3rd element too.
;; - (folding-comment-fold): Added note that function with `comment-end'
;;   is not supported. Function will flag error in those cases.
;; - (folding-convert-to-major-folds): Conversion failed if eg; you
;;   switched between modes that has 2 and 1 comments, like
;;   /* */ (C) and //(C++). Now the conversion is bit smarter, but it's
;;   impossible to convert from /* */ to // directly because we don't
;;   know how to remove */ mark, you see:
;;
;;   Original mode was C
;;
;;      /* {{{ */
;;
;;   And now used changed it to C++ mode, and ran command
;;   `folding-convert-to-major-folds'. We no longer have information
;;   about old mode's beginning or end comment markers, so we only
;;   can convert the folds to format
;;
;;     // {{{ */
;;
;;   Where the ending comment mark from old mode is left there.
;;   This is slightly imperfect situation, but at least the fold
;;   conversion works.
;;
;; Jan 28  1998  19.34             [Jari 2.25-2.29]
;; - Added `generic-mode' to fold list, suggested by Wayne Adams
;;   
;; - Finally rewrote the awesome menu-bar code: now uses standard
;;   easy-menu Which works in both XEmacs and Emacs. The menu is no
;;   longer under "Tools", but appear when minor mode is turned on.
;; - Radical changes: Decided to remove all old lucid and epoch
;;   dependencies.  Lot of code removed and reprogrammed.
;; - I also got rid of the `folding-has-minor-mode-map-alist-p' variable
;;   and old 18.xx function `folding-merge-keymaps'.
;; - Symbol's value as variable is void ((folding-xemacs-p)) error fixed.
;; - Optimized 60 `folding-use-overlays-p' calls to only 4 within
;;   `folding-subst-regions'. (Used elp.el). It seems that half of the
;;   time is spent in the function `folding-narrow-to-region'
;;   function. Could it be optimized somehow?
;; - Changed "lucid" tests to `folding-xemacs-p' variable tests.
;; - Removed `folding-hack' and print message 'Info, ignore missing
;;   functions.."  instead. It's better that we see the missing
;;   functions and not define dummy hacks for them.
;;
;; Nov 13  1997  19.34             [Jari 2.18-2.24]
;; - Added tcl-mode  fold marks, suggested by  Petteri Kettunen
;;   
;; - Removed some old code and modified the hook functions a bit.
;; - Added new user function `folding-convert-to-major-folds', key "%".
;; - Added missing items to Emacs menubar, didn't dare to touch the
;;   XEmacs part.
;; - `folding-comment-fold': Small fix. commenting didn't work on
;;   closed folds.  or if point was on topmost fold.
;; - Added `folding-advice-instantiate' And corrected byte compiler
;;   message: Warning: variable oldposn bound but not referenced
;;   Warning: reference to free variable folding-stack
;; - updated (require 'custom) code
;;
;; Nov 6  1997  19.34             [Jari 2.17]
;; - Uwe Brauer  used folding for Latex files
;;   and he wished a feature that would allow him to comment away ext
;;   that was inside fold; when compiling the TeX file.
;; - Added new user function `folding-comment-fold'. And new
;;   keybinding ";".
;;
;; Oct 8  1997  19.34             [Jari 2.16]
;; - Now the minor mode map is always re-installed when this file is
;;   loaded.  If user accidentally made mistake in
;;   `folding-default-keys-function', he can simply try again and
;;   reload this file to have the new key definitions.
;; - Previously user had to manually go and delete the previous map
;;   from the `minor-mode-map-alist' before he could try again.
;;
;; Sep 29 1997  19.34             [Jari 2.14-2.15]
;; - Robert Marshall  Sent enhancement to goto-line
;;   code. Now M-g works more intuitively.
;; - Reformatted totally the documentation so that it can be ripped to
;;   html with jari's ema-doc.pls and t2html.pls Perl scripts.
;; - Run through checkdoc.el 1.55 and Elint 1.10 and corrected code.
;; - Added defcustom support. (not tested)
;;
;; Sep 19 1997  19.28             [Jari 2.13]
;; - Robert Marshall  Sent small correction to
;;   overlay code, where the 'owner tag was set wrong.
;;
;; Aug 14 1997  19.28             [Jari 2.12 ]
;; - A small regexp bug (extra whitespace was required after closing
;;   fold) cause failing of folding-convert-buffer-for-printing in the
;;   following situation
;; - Reported by Guide. Fixed now.
;;
;;   {{{ Main topic
;;   {{{ Subsection
;;   }}}               << no space or end tag here!
;;   }}} Main topic
;;
;; Aug 14 1997  19.28             [Jari 2.11]
;; - Guide Van Hoecke  reported that
;;   he was using closing text for fold like:
;;
;;   {{{ Main topic
;;   {{{ Subsection
;;   }}} Subsection
;;   }}} Main topic
;;
;;   And when he did folding-convert-buffer-for-printing, it couldn't
;;   remove those closing marks but threw an error. I modified the
;;   function so that the regexp accepts anything after closing fold.
;;
;; Apr 18 1997  19.28             [Jari 2.10]
;; - Corrected function folding-show-current-subtree, which didn't
;;   find the correct end region, because folding-pick-move needed
;;   point at the top of beginning fold. Bug was reported by Uwe
;;   Brauer  Also changed folding-mark-look-at,
;;   which now has new call parameter 'move.
;;
;; Mar 22 1997  19.28             [Jari 2.9]
;; - Made the XEmacs20 match more stricter, so that
;;   folding-emacs-version gets value 'XEmacs19. Also added note about
;;   folding in WinNT in the compatibility section.
;; - Added sh-script-mode indented-text-mode folding marks.
;; - Moved the version from branch to the root, because the extra
;;   overlay code added, seems to be behaving well and it didn't break
;;   the existing functionality.
;;
;; Feb 17 1997  19.28             [Jari 2.8.1.2]
;; - Cleaned up Dan's changes. First: we must not replace the
;;   selective display code, but offer these two choices: Added
;;   folding-use-overlays-p function which looks variable
;;   folding-allow-overlays.
;; - Dan uses function from another Emacs specific (19.34+?) package
;;   hs-discard-overlays. This is not available in 19.28. it should
;;   be replaced with some new function... I didn't do that yet.
;; - The overlays don't exist in XEmacs. XE19.15 has promises: at least
;;   I have heard that they have overlay.el library to mimic Emacs
;;   functions.
;; - Now the overlay support can be turned on by setting
;;   folding-allow-overlays to non-nil. The default is to use selective
;;   display. Overlay Code is not tested!
;;
;; Feb 17 1997  19.28             [Dan  2.8.1.1]
;; - Dan Nicolaescu  sent patch that replaced
;;   selective display code with overlays.
;;
;; Feb 10 1997  19.28             [jari 2.8]
;; - Ricardo Marek  Kindly sent patch that
;;   makes code XEmacs 20.0 compatible. Thank you.
;;
;; Nov 7  1996  19.28             [jari 2.7]
;; - When I was on picture-mode and turned on folding, and started
;;   isearch (I don't remember how I got fold mode on exactly) it
;;   gave error that the fold marks were not defined and emacs
;;   locked up due to simultaneous isearch-loop
;; - Added few fixes to the isearch handling function to avoid
;;   infinite error loops.
;;
;; Nov 6 1996  19.28              [jari 2.5 - 2.6]
;; - Situation: have folded buffer, manually _narrow_ somewhere, C-x n n
;; - Then try searching --> folding breaks. Now it checks if the
;;   region is true narrow and not folding-narrow before trying
;;   to go outside of region and open a fold
;; - If it's true narrow, then we stay in that narrowed region.
;;
;;   folding-isearch-general               :+
;;   folding-region-has-folding-marks-p       :+
;;
;; Oct 23 1996  19.28             [jari 2.4]
;;   folding-display-name                  :+ new user cmd "C-n"
;;   folding-find-folding-mark             :+ new
;;   folding-pick-move                     :! rewritten, full of bugs
;;   folding-region-open-close             :! rewritten, full of bugs
;;
;; Oct 22 1996  19.28             [jari 2.3]
;; - folding-pick-move                     :! rewritten
;;   folding-region-open-close             :+ new user cmd "#"
;;   folding-show-current-subtree          :+ new user cmd "C-s", hides too
;;
;; Aug 01 1996  19.31             [andersl]
;; - folding-subst-regions, variable `font-lock-mode' set to nil.
;;   Thanks to 
;;
;; Jun 19 1996  19.31             [andersl]
;; - The code has proven itself stable through the beta testing phase
;;   which has lasted the past six months.
;; - A lot of comments written.
;; - The package `folding-isearch' integrated.
;; - Some code cleanup:
;;   BOLP -> folding-BOL                   :! renamed
;;   folding-behave-table                  :! field `down' removed.
;;
;;
;; Mar 14 1996  19.28             [jari  1.27]
;; - No code changes. Only some textual corrections/additions.
;; - Section "about keymaps" added.
;;
;; Mar 14 1996  19.28             [jackr 1.26]
;; - spell-check run over code.
;;
;; Mar 14 1996  19.28             [davidm 1.25]
;; - David Masterson  This patch makes the menubar in
;;   XEmacs work better. After I made this patch, the Hyperbole menus
;;   starting working as expected again. I believe the use of
;;   set-buffer-menubar has a problem, so the recommendation in XEmacs
;;   19.13 is to use set-menubar-dirty-flag.
;;
;; Mar 13 1996  19.28             [andersl 1.24]
;; - Corrected one minor bug in folding-check-if-folding-allowed
;;
;; Mar 12 1996  19.28             [jari 1.23]
;; - Renamed all -func variables to -function.
;;
;; mar 12 1996  19.28             [jari 1.22]
;; - Added new example how to change the fold marks. The automatic folding
;;   was reported to cause unnecessary delays for big files (eg. when using
;;   ediff) Now there is new function variable which can totally disable
;;   automatic folding if the return value is nil.
;;
;;   folding-check-allow-folding-function   :+ new variable
;;   folding-check-if-folding-allowed       :+ new func
;;   folding-mode-find-file                 :! modified
;;   folding-mode-write-file                :! better docs
;;   folding-goto-line                      :! arg "n" --> "N" due to XEmacs 19.13
;;
;; Mar 11 1996  19.28             [jari 1.21]
;; - Integrated changes made by Anders' to v1.19 [folding in beta dir]
;;
;; Jan 25 1996  19.28             [jari 1.20]
;; - ** Mainly cosmetic changes **
;; - Added some 'Section' codes that can be used with lisp-mnt.el
;; - Deleted all code in 'special section' because it was never used.
;; - Moved some old "-v-" named variables to better names.
;; - Removed folding-mode-flag that was never used.
;;
;; Jan 25 1996  19.28             [jari 1.19]
;; - Put Anders' latest version into RCS tree.
;;
;; Jan 03 1996  19.30             [andersl]
;; - `folding-mouse-call-original' uses `call-interactively'.
;;   `folding-mouse-context-sensitive' doesn't do `save-excursion'.
;;   (More changes will come later.)
;;   `folding-mouse-yank-at-p' macro corrected  (quote added).
;;   Error for `epoch::version' removed.
;;   `folding-mark-look-at' Regexp change .* -> [^\n\r]* to avoid error.
;;
;; Nov 24 1995  19.28             [andersl]
;; - (sequencep ) added to the code which checks for the existence
;;   of a tools menu.
;;
;; Aug 27 1995  19.28 19.12       [andersl]
;; - Keybindings restructured. They now conforms with the
;;   new 19.29 styleguide. Old keybindings are still available.
;; - Menus new goes into the "Tools" menu, if present.
;; - `folding-mouse-open-close' renamed to
;;   `folding-mouse-context-sensitive'.
;; - New entry `other' in `folding-behave-table' which defaults to
;;   `folding-calling-original'.
;; - `folding-calling-original' now gets the event from `last-input-event'
;;   if called without arguments (i.e. the way `folding-act' calls it.)
;; - XEmacs mouse support added.
;; - `folding-mouse-call-original' can call functions with or without
;;   the Event argument.
;; - Byte compiler generates no errors neither for Emacs 19 and XEmacs.
;;
;; Aug 24 1995  19.28             [jari  1.17]
;; - To prevent infinite back calling loop, Anders suggested smart way
;;   to detect that func call chain is started only once.
;;   folding-calling-original      :+ v, call chain terminator
;;   "Internal"                 :! v, all private vars have this string
;;   folding-mouse-call-original   :! v, stricter chain check.
;;   "copyright"                :! t, newer notice
;;   "commentary"               :! t, ripped non-supported emacsen
;;
;; Aug 24 1995  19.28             [jari  1.16]
;; ** mouse interface rewritten
;; - Anders gave many valuable comments about simplifying the mouse usage,
;;   he suggested that every mouse function should accept standard event,
;;   and it should be called directly.
;;   folding-global                 :- v, not needed
;;   folding-mode-off-hook          :- v, not needed
;;   folding-mouse-action-table     :- v, not needed any more
;;   folding-default-keys-function  :+ v, key settings
;;   folding-default-mouse-keys-function:+ v, key settings
;;   folding-mouse                  :- f, unnecessary
;;   'all mouse funcs'              :! f, now accept "e" parameter
;;   folding-default-keys           :+ f, defines keys
;;   folding-mouse-call-original    :+ f, call orig mouse func
;;   "examples"                     :! t, radical rewrote, only one left
;;
;; Aug 24 1995  19.28             [jari  1.15]
;; - some minor changes. If we're inside a fold, Mouse-3 will go one
;;   level up if it points END or BEG marker.
;;   folding-mouse-yank-at-point:! v, added 'up 'down
;;   folding-mark-look-at       :! f, more return values: '11 and 'end-in
;;   folding-open-close         :! f, bug, didn't exit if inside fold
;;   PMIN, PMAX, NEXTP, add-l   :+ more macros fom tinylibm.el
;;
;; Aug 23 1995  19.28             [andersl 1.14]
;; - Added `eval-when-compile' around 1.13 byte-compiler fix
;;   to avoid code to be executed when using a byte-compiled version
;;   of folding.el.
;; - Binds mode keys via `minor-mode-map-alist'
;;   (i.e. `folding-merge-keymaps' is not used in modern Emacsen.)
;;   This means that the user can not bind `folding-mode-map' to a new
;;   keymap, \\(s\\|\\)he must modify the existing one.
;; - `defvars' for global feature test variables `folding-*-p'.
;; - `folding-mouse-open-close' now detects when the current fold was been
;;   pressed. (The "current" is the fold around which the buffer is
;;   narrowed.)
;;
;; Aug 23 1995  19.28             [jari  1.13]
;; - 19.28 Byte compile doesn't handle fboundp, boundp well. That's a bug.
;;   Set some dummy functions to get cleaner output.
;; - The folding-mode-off doesn't seem very useful, because it
;;   is never run when another major-mode is turned on ... maybe we should
;;   utilize kill-all-local-variables-hooks with defadvice around
;;   kill-all-local-variables ...
;;
;;   folding-emacs-version  :+ added. it was in the docs, but not defined
;;   kill-all-local-variables-hooks  :! v, moved to variable section
;;   list-buffers-mode-alist         :! v, --''--
;;   "compiler hacks"                :+ section added
;;   "special"                       :+ section added
;;   "Compatibility"                 :! moved at the beginning
;;
;; Aug 22 1995  19.28             [jari  1.12]
;; - Only minor changes
;;   BOLP, BOLPP, EOLP, EOLPP   :+ f, macros added from tinylibm.el
;;   folding-mouse-pick-move    :! f, when cursor at beolp, move always up
;;   "bindings"                 :+ added C-cv and C-cC-v
;;
;; Aug 22 1995  19.28             [jari  1.11]
;; - Inspired by mouse so much, that this revision contain substantial
;;   changes and enhancements. Mouse is now powered!
;; - Anders wanted mouse to operate according to 'mouse cursor', not
;;   current 'point'.
;;   folding-mouse-yank-at-point: controls it. Phwew, I like this
;;   one a lot.
;;
;;   examples                       :! t, totally changed, now 2 choices
;;   folding-mode-off-hook          :+ v, when folding ends
;;   folding-global                 :+ v, global store value
;;   folding-mouse-action-table     :! v, changed
;;   folding-mouse                  :! f, stores event to global
;;   folding-mouse-open-close       :! f, renamed, mouse activated open
;;   folding-mode                   :! f, added 'off' hook
;;   folding-event-posn             :+ f, handles FSF mouse event
;;   folding-mouse-yank-at-p        :+ f, check which mouse mode is on
;;   folding-mouse-point            :+ f, return working point
;;   folding-mouse-move             :+ f, mouse moving down  , obsolete ??
;;   folding-mouse-pick-move            :+ f, mouse move accord. fold mark
;;   folding-next-visible-heading       :+ f, from tinyfold.el
;;   folding-previous-visible-heading   :+ f, from tinyfold.el
;;   folding-pick-move                  :+ f, from tinyfold.el
;;
;;
;; Aug 22 1995  19.28             [jari  1.10]
;; - Minor typing errors corrected : fol-open-close 'hide --> 'close
;;   This caused error when trying to close open fold with mouse
;;   when cursor was sitting on fold marker.
;;
;; Aug 22 1995  19.28             [jari  1.9]
;; - Having heard good suggestions from Anders...!
;;   "install"                  : add-hook for folding missed
;;   folding-open-close            : generalized
;;   folding-behave-table          : NEW, logical behavior control
;;   folding-:mouse-action-table   : now folding-mouse-action-table
;;
;; - The mouse function seems to work with FSF emacs only, because
;;   XEmacs doesn't know about double or triple clicks. We're working
;;   on the problem...
;;
;; Aug 21 1995  19.28             [jari  1.8]
;; - Rearranged the file structure so that all variables are at the
;;   beginning of file. With new functions, it easy to open-close
;;   fold. Added word "code:" or "setup:" to the front of code folds,
;;   so that the toplevel folds can be recognized more easily.
;; - Added example hook to install section for easy mouse use.
;; - Added new functions.
;;   folding-get-mode-marks : return folding marks
;;   folding-mark-look-at   : status of current line, fold mark in it?
;;   folding-mark-mouse     : execute action on fold mark
;;
;;
;; Aug 17 1995  19.28/X19.12      [andersl 1.7]
;; - Failed when loaded into XEmacs, when `folding-mode-map' was
;;   undefined.  Folding marks for three new major modes added:
;;   rexx-mode, erlang-mode and xerl-mode.
;;
;; Aug 14 1995  19.28             [jari  1.6]
;; - After I met Anders we exchanged some thoughts about usage philosophy
;;   of error and signal commands. I was annoyed by the fact that they
;;   couldn't be suppressed, when the error was "minor". Later Anders
;;   developed fdb.el, which will be integrated to FSF 19.30. It
;;   offers by-passing error/signal interference.
;;   --> I changed back all the error commands that were taken away.
;;
;; Jun 02 1995  19.28             [andersl]
;; - "Narrow" not present in mode-line when in folding-mode.
;;
;; May 12 1995  19.28             [jari  1.5]
;; - Installation text cleaned: reference to 'install-it' removed,
;;   because such function doesn't exist any more. The installation is
;;   now automatic: it's done when user calls folding mode first time.
;; - Added 'private vars' section. made 'outside all folds' message
;;   informational, not an error.
;;
;; May 12 1995  19.28             [jackr  x.x]
;; - Corrected 'broken menu bar' problem.
;; - Even though make-sparse-keymap claims its argument (a string to
;;   name the  menu) is optional, it's not. Lucid has other
;;   arrangements for the same thing..
;;
;; May 10 1995  19.28             [jari 1.2]
;; - Moved provide to the end of file.
;; - Rearranged code so that the common functions are at the beginning.
;;   Reprogrammed the whole installation with hooks. Added Write file
;;   hook that makes sure you don't write in 'binary' while folding were
;;   accidentally off.
;; - Added regexp text for certain files which are not allowed to
;;   'auto fold' when loaded.
;; - changed some 'error' commands to 'messages', this prevent screen
;;   mixup when debug-on-error is set to t
;; + folding-list-delete , folding-msg , folding-mode-find-file ,
;;   folding-mode-write-file , folding-check-folded , folding-keep-hooked
;;
;; 1.7.4 May 04 1995  19.28             [jackr 1.11]
;; - Some compatibility changes:
;;      v.18 doesn't allow an arg to make-sparse-keymap
;;      testing epoch::version is trickier than that
;;      free-variable reference cleanup
;;
;; 1.7.3 May 04 1995  19.28             [jari]
;; - Corrected folding-mode-find-file-hook , so that it has more
;;   'mode turn on' capabilities through user function
;; + folding-mode-write-file-hook: Makes sure your file is saved
;;   properly, so that you don't end up saving in 'binary'.
;; + folding-check-folded: func, default checker provided
;; + folding-check-folded-file-function variable added, User can put his
;;   'detect folding.el file' methods here.
;; + folding-mode-install-it: func, Automatic installation with it
;;
;; 1.7.2  Apr 01 1995   19.28           [jackr] , Design support by [jari]
;; - Added folding to FSF & XEmacs menus
;;
;; 1.7.1  Apr 28 1995   19.28           [jackr]
;; - The folding editor's merge-keymap couldn't handle FSF menu-bar,
;;   so some minor changes were made, previous is '>' and enhancements
;;   are '>'
;;
;; <     (buffer-disable-undo new-buffer)
;; ---
;; >     (buffer-flush-undo new-buffer)
;; 1510,1512c1510
;; <                    key (if (symbolp keycode)
;; <                            (vector keycode)
;; <                          (char-to-string keycode))
;; ---
;; >                    key (char-to-string keycode)
;; 1802,1808d1799
;; < ;;{{{ Compatibility hacks for various Emacs versions
;; <
;; < (or (fboundp 'buffer-disable-undo)
;; <     (fset 'buffer-disable-undo (symbol-function 'buffer-flush-undo)))
;; <
;; < ;;}}}
;;
;;
;; X.x  Dec 1   1994    19.28           [jari]
;; - Only minor change. Made the folding mode string user configurable.
;;   Added these variables:
;;   folding-mode-string, folding-inside-string,folding-inside-mode-name
;; - Changed revision number from 1.6.2 to 1.7 , so that people know
;;   this package has changed.

;;}}}

;;; Code:

;;{{{ setup: require packages

;;; ......................................................... &require ...

(eval-when-compile
  (require 'cl))

(eval-and-compile
  (autoload 'font-lock-fontify-region "font-lock")
  ;; Forward declaration
  (defvar global-font-lock-mode))

(require 'easymenu)

(defvar folding-package-url-location
  "Latest folding is available at http://cvs.xemacs.org/viewcvs.cgi/XEmacs/packages/xemacs-packages/text-modes/")

;;}}}
;;{{{ setup: byte compiler hacks

;;; ............................................. &byte-compiler-hacks ...
;;; - This really only should be evaluated in case we're about to byte
;;;   compile this file. Since `eval-when-compile' is evaluated when
;;;   the uncompiled version is used (great!) we test if the
;;;   byte-compiler is loaded.

;; Make sure `advice' is loaded when compiling the code.

(eval-and-compile
  (require 'advice)
  (defvar folding-xemacs-p (or (boundp 'xemacs-logo)
                               (featurep 'xemacs))
    "Folding determines which emacs version it is running. t if Xemacs.")
  ;;  loading overlay.el package removes some byte compiler whinings.
  ;;  By default folding does not use overlay code.
  (if folding-xemacs-p
      (or (fboundp 'overlay-start)  ;; Already loaded
          (load "overlay" 'noerr)   ;; No? Try loading it.
          (message "\
** folding.el: XEmacs 19.15+ has package overlay.el, try to get it.
               This is only warning. Folding does not use overlays by
               default.  You can safely ignore possible overlay byte
               compilation error
               messages."))))

(eval-when-compile

  (when nil ;; Disabled 2000-01-05
    ;; While byte compiling
    (if (string= (buffer-name) " *Compiler Input*")
        (progn
          (message "** folding.el:\
 Info, Ignore [X]Emacs's missing motion/event/posn functions calls"))))

  ;; ARGS: (symbol variable-p library)
  (defadvice find-function-search-for-symbol (around folding act)
    "Set folding flag for `find-file-noselect' to open all folds."
    (let ((file (ad-get-arg 2)))
      (when file
        (message "FILE %s" file)
        (put 'find-file-noselect 'folding file)))
    ad-do-it
    (put 'find-file-noselect 'folding nil))

  (defun folding-find-file-noselect ()
    (let* ((file   (get 'find-file-noselect 'folding))
           (buffer (and file
                        ;; It may be absolute path name, file.el,
                        ;; or just "file".
                        (or (find-buffer-visiting file)
                            (get-buffer file)
                            (get-buffer (concat file ".el"))))))
      (when buffer
        (with-current-buffer buffer
          (when (symbol-value 'folding-mode) ;; Byte compiler silencer
            (turn-off-folding-mode))))))

  ;;  See find.func.el  find-function-search-for-symbol
  ;;  Make C-h f  and mouse-click work to jump to a file. Folding mode
  ;;  Must be turned off due to regexps in find.func.el that can't
  ;;  search ^M lines.

  (defadvice find-file-noselect (after folding act)
    "When called by `find-function-search-for-symbol', turn folding off."
    (folding-find-file-noselect))

  (defadvice make-sparse-keymap
    (before
     make-sparse-keymap-with-optional-argument
     (&optional byte-compiler-happyfier)
     activate)
    "This advice does nothing except adding an optional argument
to keep the byte compiler happy when compiling Emacs specific code
with XEmacs.")

  ;; XEmacs and Emacs 19 differs when it comes to obsolete functions.
  ;; We're using the Emacs 19 versions, and this simply makes the
  ;; byte-compiler stop wining. (Why isn't there a warning flag which
  ;; could have turned off?)

  (and (boundp 'mode-line-format)
       (put 'mode-line-format 'byte-obsolete-variable nil))

  (and (fboundp 'byte-code-function-p)
       (put 'byte-code-function-p 'byte-compile nil))

  (and (fboundp 'eval-current-buffer)
       (put 'eval-current-buffer 'byte-compile nil)))

(defsubst folding-preserve-active-region ()
  "In XEmacs keep the region alive. In Emacs do nothing."
  (if (boundp 'zmacs-region-stays)      ;Keep regions alive
      (set 'zmacs-region-stays t))) ;use `set' to Quiet Emacs Byte Compiler

;; Work around the NT Emacs Cut'n paste bug in selective-display which
;; doesn't preserve C-m's. Only installed in problematic Emacs and
;; in other cases these lines are no-op.

(eval-and-compile
  (when (and (not folding-xemacs-p)
             (memq (symbol-value 'window-system) '(win32 w32)) ; NT Emacs
             (string< emacs-version "20.4")) ;at least in 19.34 .. 20.3.1

    (unless (fboundp 'char-equal)
      (defalias 'char-equal  'equal))

    (unless (fboundp 'subst-char)
      (defun subst-char (str char to-char)
        "Replace in STR every CHAR with TO-CHAR."
        (let ((len   (length str))
              (ret   (copy-sequence str))) ;because 'aset' is destructive
          (while (> len 0)
            (if (char-equal (aref str (1- len)) char)
                (aset ret (1- len) to-char))
            (decf len))
          ret)))

    (defadvice kill-new (around folding-win32-fix-selective-display act)
      "In selective display, convert each C-m to C-a. See `current-kill'."
      (let* ((string (ad-get-arg 0)))
        (when (and selective-display (string-match "\C-m" (or string "")))
          (setq string (subst-char string ?\C-m ?\C-a)))
        ad-do-it))

    (defadvice current-kill (around folding-win32-fix-selective-display act)
      "In selective display, convert each C-a back to C-m. See `kill-new'."
      ad-do-it
      (let* ((string ad-return-value))
        (when (and selective-display (string-match "\C-a" (or string "")))
          (setq string (subst-char string ?\C-a ?\C-m))
          (setq ad-return-value string))))))

(defvar folding-mode) ;; Byte Compiler silencer

(when (locate-library "mode-motion") ;; XEmacs
  (defun folding-mode-motion-highlight-fold (event)
    "Highlight line under mouse if it has a foldmark."
    (when folding-mode
      (funcall
       ;; Emacs Byte Compiler Shutup fix
       (symbol-function 'mode-motion-highlight-internal)
       event
       (function
        (lambda ()
          (beginning-of-line)
          (if (folding-mark-look-at)
              (search-forward-regexp "^[ \t]*"))))
       (function
        (lambda ()
          (if (folding-mark-look-at)
              (end-of-line)))))))
  (require 'mode-motion)
  (add-hook 'mode-motion-hook 'folding-mode-motion-highlight-fold 'at-end))

;;}}}

;;{{{ setup: some variable

;;; .................................................. &some-variables ...

;; This is a list of structures which keep track of folds being entered
;; and exited. It is a list of (MARKER . MARKER) pairs, followed by the
;; symbol `folded'. The first of these represents the fold containing
;; the current one. If the view is currently outside all folds, this
;; variable has value nil.

(defvar folding-stack nil
  "Internal. A list of marker pairs representing folds entered so far.")

(defvar folding-version (substring "$Revision: 1.5 $" 11 15)
  "Version number of folding.el.")

;;}}}
;;{{{ setup: bind

;;; .......................................................... &v-bind ...

(defgroup folding nil
  "Managing buffers with Folds."
  :group 'tools)

(defcustom folding-mode-prefix-key "\C-c@"
  "*Prefix key to use for Folding commands in Folding mode."
  :type  'string
  :group 'folding)

(defcustom folding-goto-key "\M-g"
  "*Key to be bound to `folding-goto-line' in folding mode.
The default value is M - g, but you probably don't want folding to
occupy it if you have used M - g got `goto-line'."
  :type  'string
  :group 'folding)

(defcustom folding-font-lock-begin-mark 'font-lock-reference-face
  "Face to highlight beginning fold mark."
  :type  'face
  :group 'folding)

(defcustom folding-font-lock-end-mark 'font-lock-reference-face
  "Face to highlight end fold mark."
  :type  'face
  :group 'folding)

(defvar folding-mode-map nil
  "Keymap used in Folding mode (a minor mode).")

(defvar folding-mode-prefix-map nil
  "Keymap used in Folding mode keys sans `folding-mode-prefix-key'.")

;;;###autoload
(defvar folding-mode nil
  "When Non nil, Folding mode is active in the current buffer.")

(make-variable-buffer-local 'folding-mode)
(set-default 'folding-mode nil)

(defmacro folding-kbd (key function)
  "Folding: define KEY with FUNCTION to `folding-mode-prefix-map'.
This is used when assigning keybindings to `folding-mode-map'.
See also `folding-mode-prefix-key'."
  `(define-key
     folding-mode-prefix-map
     ,key ,function))

(defun folding-bind-default-mouse ()
  "Bind default mouse keys used by Folding mode."
  (interactive)
  (cond
   (folding-xemacs-p
    (define-key folding-mode-map [(button3)]
      'folding-mouse-context-sensitive)
    ;; (define-key folding-mode-map '(double button3) 'folding-hide-current-entry)
    (define-key folding-mode-map [(control shift button2)]
      'folding-mouse-pick-move))
   (t
    (define-key folding-mode-map [mouse-3]     'folding-mouse-context-sensitive)
    (define-key folding-mode-map [C-S-mouse-2] 'folding-mouse-pick-move))))

(defun folding-bind-terminal-keys ()
  "In non-window system, rebind C - f and C - b as folding-{forward,backward}-char."
  (unless (or (and (boundp 'window-system)        ;; Emacs
                   (symbol-value 'window-system)) ;; Byte compiler silencer
              (and (fboundp 'console-type)        ;; XEmacs
                   (let ((val (fboundp 'console-type)))
                     (not (eq 'tty val)))))
    (define-key folding-mode-map "\C-f" 'folding-forward-char)
    (define-key folding-mode-map "\C-b" 'folding-backward-char)))

(defun folding-bind-default-keys ()
  "Bind the default keys used the `folding-mode'.

The variable `folding-mode-prefix-key' contains the prefix keys,
the default is C - c @.

For the good ol' key bindings, please use the function
`folding-bind-backward-compatible-keys' instead."
  (interactive)
  (define-key folding-mode-map folding-goto-key 'folding-goto-line)
  (folding-bind-terminal-keys)
  (define-key folding-mode-map "\C-e" 'folding-end-of-line)
  (folding-kbd "\C-f"   'folding-fold-region)
  (folding-kbd ">"      'folding-shift-in)
  (folding-kbd "<"      'folding-shift-out)
  (folding-kbd "\C-t"   'folding-show-all)
  (folding-kbd "\C-s"   'folding-show-current-entry)
  (folding-kbd "\C-x"   'folding-hide-current-entry)
  (folding-kbd "\C-o"   'folding-open-buffer)
  (folding-kbd "\C-w"   'folding-whole-buffer)
  (folding-kbd "\C-r"   'folding-convert-buffer-for-printing)
  (folding-kbd "\C-k"   'folding-marks-kill)
  (folding-kbd  "\C-v"  'folding-pick-move)
  (folding-kbd  "v"     'folding-previous-visible-heading)
  (folding-kbd  " "     'folding-next-visible-heading)
  (folding-kbd  "."     'folding-context-next-action)
  ;;  C-u:  kinda "up" -- "down"
  (folding-kbd "\C-u"   'folding-toggle-enter-exit)
  (folding-kbd "\C-q"   'folding-toggle-show-hide)
  ;; Think "#" as a 'fence'
  (folding-kbd "#"      'folding-region-open-close)
  ;; Esc-; is the standard emacs commend add key.
  (folding-kbd ";"      'folding-comment-fold)
  (folding-kbd "%"      'folding-convert-to-major-folds)
  (folding-kbd "/"      'folding-all-comment-blocks-in-region)
  (folding-kbd "\C-y"   'folding-show-current-subtree)
  (folding-kbd "\C-z"   'folding-hide-current-subtree)
  (folding-kbd "\C-n"   'folding-display-name)
  (folding-kbd "I"      'folding-insert-advertise-folding-mode))

(defun folding-bind-backward-compatible-keys ()
  "Bind keys traditionally used by Folding mode.
For bindings which follow newer Emacs minor mode conventions, please
use the function `folding-bind-default-keys'.

This function sets `folding-mode-prefix-key' to `C-c'."
  (interactive)
  (setq folding-mode-prefix-key "\C-c")
  (folding-bind-default-keys))

(defun folding-bind-outline-compatible-keys ()
  "Bind keys used by the minor mode `folding-mode'.
The keys used are as much as possible compatible with
bindings used by Outline mode.

Currently, some outline mode functions doesn't have a corresponding
folding function.

The variable `folding-mode-prefix-key' contains the prefix keys,
the default is C - c @.

For the good ol' key bindings, please use the function
`folding-bind-backward-compatible-keys' instead."
  (interactive)
  ;; Traditional keys:
  (folding-bind-terminal-keys)
  (define-key folding-mode-map "\C-e" 'folding-end-of-line)
  ;; Mimic Emacs 20.3 allout.el bindings
  (folding-kbd ">"          'folding-shift-in)
  (folding-kbd "<"          'folding-shift-out)
  (folding-kbd "\C-n"  'folding-next-visible-heading)
  (folding-kbd "\C-p"  'folding-previous-visible-heading)
  ;; ("\C-u" outline-up-current-level)
  ;; ("\C-f" outline-forward-current-level)
  ;; ("\C-b" outline-backward-current-level)
  ;;  (folding-kbd "\C-i"  'folding-show-current-subtree)
  (folding-kbd "\C-s"  'folding-show-current-subtree)
  (folding-kbd "\C-h"  'folding-hide-current-subtree)
  (folding-kbd "\C-k"  'folding-marks-kill)
  (folding-kbd "!"     'folding-show-all)
  (folding-kbd "\C-d"  'folding-hide-current-entry)
  (folding-kbd "\C-o"  'folding-show-current-entry)
  ;; (" " outline-open-sibtopic)
  ;; ("." outline-open-subtopic)
  ;; ("," outline-open-supertopic)
  ;; Other bindings not in allout.el
  (folding-kbd "\C-a"  'folding-open-buffer)
  (folding-kbd "\C-q"  'folding-whole-buffer)
  (folding-kbd "\C-r"  'folding-convert-buffer-for-printing)
  (folding-kbd "\C-w"  'folding-fold-region)
  (folding-kbd "I"      'folding-insert-advertise-folding-mode))

;;{{{ goto-line (advice)

(defcustom folding-advice-instantiate t
  "*In non-nil install advice code. Eg for `goto-line'."
  :type  'boolean
  :group 'folding)

(defcustom folding-shift-in-on-goto t
  "*Flag in folding adviced function `goto-line'.
If non-nil, folds are entered when going to a given line.
Otherwise the buffer is unfolded. Can also be set to 'show.
This variable is used only if `folding-advice-instantiate' was
non-nil when folding was loaded.

See also `folding-goto-key'."
  :type  'boolean
  :group 'folding)

(defvar folding-narrow-by-default t
  "If t (default) things like isearch will enter folds.  If nil the
folds will be opened, but not entered.")

(when folding-advice-instantiate
  (eval-when-compile (require 'advice))
  ;; By Robert Marshall 
  (defadvice goto-line (around folding-goto-line first activate)
    "Go to line ARG, entering folds if `folding-shift-in-on-goto' is t.
It attempts to keep the buffer in the same visibility state as before."
    (let () ;; (oldposn (point))
      ad-do-it
      (if (and folding-mode
               (or (folding-point-folded-p (point))
                   (<= (point) (point-min-marker))
                   (>= (point) (point-max-marker))))
          (let ((line (ad-get-arg 0)))
            (if folding-shift-in-on-goto
                (progn
                  (folding-show-all)
                  (goto-char 1)
                  (and (< 1 line)
                       (not (folding-use-overlays-p))
                       (re-search-forward "[\n\C-m]" nil 0 (1- line)))
                  (let ((goal (point)))
                    (while (prog2 (beginning-of-line)
                               (if folding-shift-in-on-goto
                                   (progn
                                     (folding-show-current-entry t t)
                                     (folding-point-folded-p goal))
                                 (folding-shift-in t))
                             (goto-char goal)))
                    (folding-narrow-to-region
                     (and folding-narrow-by-default (point-min))
                     (point-max) t)))
              (if (or folding-stack (folding-point-folded-p (point)))
                  (folding-open-buffer))))))))

;;}}}

(defun folding-bind-foldout-compatible-keys ()
  "Bind keys for `folding-mode' compatible with Foldout mode.

The variable `folding-mode-prefix-key' contains the prefix keys,
the default is C - c @."
  (interactive)
  (folding-kbd "\C-z" 'folding-shift-in)
  (folding-kbd "\C-x" 'folding-shift-out))

;;; This function is here, just in case we ever would like to add
;;; `hideif' support to folding mode. Currently, it is only used to
;;; which keys shouldn't be used.

;;(defun folding-bind-hideif-compatible-keys ()
;;  "Bind keys for `folding-mode' compatible with Hideif mode.
;;
;;The variable `folding-mode-prefix-key' contains the prefix keys,
;;the default is C-c@."
;;  (interactive)
;;    ;; Keys defined by `hideif'
;;    ;; (folding-kbd "d" 'hide-ifdef-define)
;;    ;; (folding-kbd "u" 'hide-ifdef-undef)
;;    ;; (folding-kbd "D" 'hide-ifdef-set-define-alist)
;;    ;; (folding-kbd "U" 'hide-ifdef-use-define-alist)
;;
;;    ;; (folding-kbd "h") 'hide-ifdefs)
;;    ;; (folding-kbd "s") 'show-ifdefs)
;;    ;; (folding-kbd "\C-d") 'hide-ifdef-block)
;;    ;; (folding-kbd "\C-s") 'show-ifdef-block)
;;
;;    ;; (folding-kbd "\C-q" 'hide-ifdef-toggle-read-only)
;;    )

;;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .

;; Not used for modern Emacsen.
(defvar folding-saved-local-keymap nil
  "Keymap used to save non-folding keymap.
(so it can be restored when folding mode is turned off.)")

;;;###autoload
(defcustom folding-default-keys-function 'folding-bind-default-keys
  "*Function or list of functions used to define keys for Folding mode.
Possible values are:
  folding-bind-default-key
        The standard keymap.

  `folding-bind-backward-compatible-keys'
        Keys used by older versions of Folding mode. This function
        does not conform to Emacs 19.29 style conversions concerning
        key bindings. The prefix key is C - c

  `folding-bind-outline-compatible-keys'
        Define keys compatible with Outline mode.

  `folding-bind-foldout-compatible-keys'
        Define some extra keys compatible with Foldout.

All except `folding-bind-backward-compatible-keys' used the value of
the variable `folding-mode-prefix-key' as prefix the key.
The default is C - c @"
  :type  'function
  :group 'folding)

;; Not yet implemented:
;;  folding-bind-hideif-compatible-keys
;;      Define some extra keys compatible with hideif.

;;;###autoload
(defcustom folding-default-mouse-keys-function 'folding-bind-default-mouse
  "*Function to bind default mouse keys to `folding-mode-map'."
  :type 'function
  :group 'folding)

(defvar folding-mode-menu nil
  "Keymap containing the menu for Folding mode.")

(defvar folding-mode-menu-name "Fld" ;; Short menu name
  "Name of pull down menu.")

;;}}}
;;{{{ setup: hooks

;;; ......................................................... &v-hooks ...

(defcustom folding-mode-hook nil
  "*Hook called when Folding mode is entered.

A hook named `-folding-hook' is also called, if it
exists. Eg., `c-mode-folding-hook' is called whenever Folding mode is
started in C mode."
  :type 'hook
  :group 'folding)

(defcustom folding-load-hook nil
  "*Hook run when file is loaded."
  :type 'hook
  :group 'folding)

;;}}}
;;{{{ setup: user config

;;; ........................................................ &v-Config ...

;; Q: should this inherit mouse-yank-at-point's value? maybe not.
(defvar folding-mouse-yank-at-point t
  "If non-nil, mouse activities are done at point instead of 'mouse cursor'.
Behaves like `mouse-yank-at-point'.")

(defcustom folding-folding-on-startup t
  "*If non-nil, buffers are folded when starting Folding mode."
  :type 'boolean
  :group 'folding)

(defcustom folding-internal-margins 1
  "*Number of blank lines left next to fold mark when tidying folds.

This variable is local to each buffer. To set the default value for all
buffers, use `set-default'.

When exiting a fold, and at other times, `folding-tidy-inside' is invoked
to ensure that the fold is in the correct form before leaving it. This
variable specifies the number of blank lines to leave between the
enclosing fold marks and the enclosed text.

If this value is nil or negative, no blank lines are added or removed
inside the fold marks. A value of 0 (zero) is valid, meaning leave no
blank lines.

See also `folding-tidy-inside'."
  :type  'boolean
  :group 'folding)

(make-variable-buffer-local 'folding-internal-margins)

(defvar folding-mode-string " Fld"
  "Buffer-local variable that hold the fold depth description.")

(set-default 'folding-mode-string " Fld")

;; Sets `folding-mode-string' appropriately. This allows the Folding mode
;; description in the mode line to reflect the current fold depth.

(defconst folding-inside-string " "     ; was ' inside ',
  "Mode line addition to show 'inside' levels of fold.")

;;;###autoload
(defcustom folding-inside-mode-name "Fld"
  "*Mode line addition to show inside levels of 'fold' ."
  :type  'string
  :group 'folding)

(defcustom folding-check-folded-file-function
  'folding-check-folded
  "*Function that return t or nil after examining if the file is folded."
  :type  'function
  :group 'folding)

(defcustom folding-check-allow-folding-function
  'folding-check-if-folding-allowed
  "*Function that return t or nil after deciding if automatic folding."
  :type  'function
  :group 'folding)

;;;###autoload
(defcustom folding-mode-string "Fld"
  "*The minor mode string displayed when mode is on."
  :type  'string
  :group 'folding)

;;;###autoload
(defcustom folding-mode-hook-no-regexp "RMAIL"
  "*Regexp which disable automatic folding mode turn on for certain files."
  :type  'string
  :group 'folding)

;;; ... ... ... ... ... ... ... ... ... ... ... ... ... .... &v-tables ...

(defcustom folding-behave-table
  '((close      folding-hide-current-entry)
    (open       folding-show-current-entry) ; Could also be `folding-shift-in'.
    (up         folding-shift-out)
    (other      folding-mouse-call-original))
  "*Table of of logical commands and their associated functions.
If you want fold to behave like `folding-shift-in', when it 'open'
a fold, you just change the function entry in this table.

Table form:
  '( (LOGICAL-ACTION  CMD) (..) ..)"
  :type '(repeat
          (symbol   :tag "logical action")
          (function :tag "callback"))
  :group 'folding)

;;; ... ... ... ... ... ... ... ... ... ... ... ... ... ..... &v-marks ...

;;;###autoload
(defvar folding-mode-marks-alist nil
  "List of (major-mode . fold mark) default combinations to use.
When Folding mode is started, the major mode is checked, and if there
are fold marks for that major mode stored in `folding-mode-marks-alist',
those marks are used by default. If none are found, the default values
of \"{{{ \" and \"}}}\" are used.

Use function  `folding-add-to-marks-list' to add more fold marks. The function
also explains the alist use in details.

Use function `folding-set-local-variables' if you change the current mode's
folding marks during the session.")

;;}}}
;;{{{ setup: private

;;; ....................................................... &v-private ...

(defvar folding-narrow-placeholder nil
  "Internal. Mark where \"%n\" used to be in `mode-line-format'.
Must be nil.")

(defvar folding-bottom-mark nil
  "Internal marker of the true bottom of a fold.")

(defvar folding-bottom-regexp nil
  "Internal. Regexp marking the bottom of a fold.")

(defvar folding-regexp nil
  "Internal. Regexp for hunting down the `folding-top-mark' even in comments.")

(defvar folding-secondary-top-mark nil
  "Internal. Additional stuff that can be inserted as part of a top marker.")

(defvar folding-top-mark nil
  "Internal. The actual string marking the top of a fold.")

(defvar folding-top-regexp nil
  "Internal.
Regexp describing the string beginning a fold, possible with
leading comment thingies and like that.")

(defvar folded-file nil
  "Enter folding mode when this file is loaded.
(buffer local, use from a local variables list).")

(defvar folding-calling-original nil
  "Internal. Non-nil when original mouse binding is executed.")

(defvar folding-narrow-overlays nil
  "Internal. Keep the list of overlays.")
(make-variable-buffer-local 'folding-narrow-overlays)

(defcustom folding-allow-overlays nil
  "*If non-nil use overlay code. If nil, then selective display is used.
Note, that this code is highly experimental and will not most likely do what
you expect. using value t will not change folding to use overlays
completely. This variable was introduced to experiment with the overlay
interface, but the work never finished and it is unlikely that it
will continued any later time. Folding at present state is designed
too highly for selective display to make the change worthwhile."
  :type 'boolean
  :group 'folding)

;;}}}
;;{{{ Folding install

(defun folding-easy-menu-define ()
  "Define folding easy menu."
  (interactive)
  (easy-menu-define
    folding-mode-menu
    (if folding-xemacs-p
        nil
      (list folding-mode-map))
    "Folding menu"
    (list
     folding-mode-menu-name
     ["Enter Fold"                       folding-shift-in                t]
     ["Exit Fold"                        folding-shift-out               t]
     ["Show Fold"                        folding-show-current-entry      t]
     ["Hide Fold"                        folding-hide-current-entry      t]
     "----"
     ["Show Whole Buffer"                folding-open-buffer             t]
     ["Fold Whole Buffer"                folding-whole-buffer            t]
     ["Show subtree"                     folding-show-current-subtree    t]
     ["Hide subtree"                     folding-hide-current-subtree    t]
     ["Display fold name"                folding-display-name            t]
     "----"
     ["Move previous"                    folding-previous-visible-heading t]
     ["Move next"                        folding-next-visible-heading    t]
     ["Pick fold"                        folding-pick-move               t]
     ["Next action (context)"            folding-context-next-action     t]
     "----"
     ["Foldify region"                   folding-fold-region             t]
     ["Open or close folds in region"    folding-region-open-close       t]
     ["Open folds to top level"          folding-show-all                t]
     "----"
     ["Comment text in fold"             folding-comment-fold            t]
     ["Convert for printing(temp buffer)"
      folding-convert-buffer-for-printing t]
     ["Convert to major-mode folds"      folding-convert-to-major-folds  t]
     ["Move comments inside folds in region"
      folding-all-comment-blocks-in-region t]
     ["Delete fold marks in this fold"   folding-marks-kill              t]
     ["Insert folding URL reference"
      folding-insert-advertise-folding-mode t]
     "----"
     ["Toggle enter and exit mode"       folding-toggle-enter-exit       t]
     ["Toggle show and hide"             folding-toggle-show-hide        t]
     "----"
     ["Folding mode off"                 folding-mode t])))

(defun folding-install-keymaps ()
  "Install keymaps."
  (unless folding-mode-map
    (setq folding-mode-map          (make-sparse-keymap)))
  (unless folding-mode-prefix-map
    (setq folding-mode-prefix-map   (make-sparse-keymap)))
  (if (listp folding-default-keys-function)
      (mapc 'funcall folding-default-keys-function)
    (funcall folding-default-keys-function))
  (funcall folding-default-mouse-keys-function)
  (folding-easy-menu-define)
  (define-key folding-mode-map
    folding-mode-prefix-key folding-mode-prefix-map)
  ;; Install the keymap into `minor-mode-map-alist'. The keymap will
  ;; be activated as soon as the variable `folding-mode' is set to
  ;; non-nil.
  (let ((elt (assq 'folding-mode minor-mode-map-alist)))
    ;;  Always remove old map before adding new definitions.
    (if elt
        (setq minor-mode-map-alist
              (delete elt minor-mode-map-alist)))
    (push (cons 'folding-mode folding-mode-map) minor-mode-map-alist))
  ;;  Update minor-mode-alist
  (or (assq 'folding-mode minor-mode-alist)
      (push '(folding-mode folding-mode-string) minor-mode-alist))
  ;;  Needed for XEmacs
  (or (fboundp 'buffer-disable-undo)
      (fset 'buffer-disable-undo (symbol-function 'buffer-flush-undo))))

(defun folding-uninstall-keymaps ()
  "Uninstall keymaps."
  (let ((elt (assq 'folding-mode minor-mode-map-alist)))
    (if elt
        (setq minor-mode-map-alist
              (delete elt minor-mode-map-alist)))
    (if (setq elt (assq 'folding-mode minor-mode-alist))
        (setq minor-mode-alist
              (delete elt minor-mode-alist)))
    (folding-uninstall-hooks)))

(defun folding-install (&optional uninstall)
  "Install or UNINSTALL folding."
  (interactive "P")
  (cond
   (uninstall
    (folding-uninstall-keymaps)
    (folding-uninstall-hooks))
   (t
    (folding-install-keymaps))))

(defun folding-uninstall ()
  "Uninstall folding."
  (interactive)
  (folding-install 'uninstall)
  ;; Unwrap all buffers.
  (dolist (buffer (buffer-list))
    (with-current-buffer buffer
      (goto-char (point-min))
      (when (or folding-mode
                ;;  To be sure, check this at the same time
                ;;  Somebody may have just done
                ;;  (setq folding-mode nil), which is bad thing.
                ;;  Setting variable won't restore the buffer.
                (re-search-forward "{{{" nil t))
        (turn-off-folding-mode)))))

;;}}}
;;{{{ code: misc

(defsubst folding-get-mode-marks (&optional mode)
  "Return fold markers for MODE. default is for current `major-mode'.

Return:
  \(beg-marker end-marker\)"
  (interactive)
  (let* (elt)
    (unless (setq elt (assq (or mode major-mode)
                            folding-mode-marks-alist))
      (error "Folding error: mode is not in `folding-mode-marks-alist'"))
    (list (nth 1 elt) (nth 2 elt) (nth 3 elt))))

(defun folding-region-has-folding-marks-p (beg end)
  "Check is there is fold mark in region BEG END."
  (save-excursion
    (goto-char beg)
    (when (memq (folding-mark-look-at) '(1 11))
      (goto-char end)
      (memq (folding-mark-look-at) '(end end-in)))))

;;; - Thumb rule: because "{{{" if more meaningful, all returns values
;;;   are of type integerp if it is found.
;;;
(defun folding-mark-look-at (&optional mode)
  "Check status of current line. Does it contain a fold mark?.

MODE

 'move      move over fold mark

Return:

  0 1       numberp, line has fold begin mark
            0 = closed, 1 = open,
            11 = open, we're inside fold, and this is top marker

  'end      end mark

  'end-in   end mark, inside fold, floor marker

  nil       no fold marks .."
  (let* (case-fold-search
         (marks  (folding-get-mode-marks))
         (stack  folding-stack)
         (bm     (regexp-quote (nth 0 marks))) ;begin mark
         (em     (concat "^[ \t\n]*" (regexp-quote  (nth 1 marks))))
         (bm-re  (concat
                  (concat "^[ \t\n]*" bm)
                  (if (and nil
                           (string=
                            " " (substring (nth 0 marks)
                                           (length (nth 1 marks)))))
                      ;; Like "}}} *"
                      "*"
                    "")))
         ret
         point)
    (save-excursion
      (beginning-of-line)
      (cond
       ((looking-at bm-re)
        (setq point (point))
        (cond
         ((looking-at (concat "^[ \t\n]*" bm "[^\r\n]*\r")) ;; closed
          (setq ret 0))
         (t ;; open fold marker
          (goto-char (point-min))
          (cond
           ((and stack ;; we're inside fold
                 ;;  allow spaces
                 (looking-at (concat "[ \t\n]*" bm)))
            (setq ret 11))
           (t
            (setq ret 1))))))
       ((looking-at em)
        (setq point (point))
        ;; - The stack is a list if we've entered inside fold. There
        ;;   is no text after fold END mark
        ;; - At bol  ".*\n[^\n]*" doesn't work but "\n[^\n]*" at eol does??
        (cond
         ((progn
            (end-of-line)
            (or (and stack (eobp))      ;normal ending
                (and stack             ;empty newlines only, no text ?
                     (not (looking-at "\n[^ \t\n]*")))))
          (setq ret 'end-in))
         (t                             ;all rest are newlines
          (setq ret 'end))))))
    (cond
     ((and mode point)
      (goto-char point)
      ;;  This call breaks if there is no marks on the point,
      ;;  because there is no parameter 'nil t' in call.
      ;;  --> there is error in this function if that happens.
      (beginning-of-line)
      (re-search-forward (concat bm "\\|" em))
      (backward-char 1)))
    ret))

(defsubst folding-mark-look-at-top-mark-p ()
  "Check if line contain folding top marker."
  (integerp (folding-mark-look-at)))

(defsubst folding-mark-look-at-bottom-mark-p ()
  "Check if line contain folding bottom marker."
  (symbolp (folding-mark-look-at)))

(defun folding-act (action &optional event)
  "Execute logical ACTION based on EVENT.

References:
  `folding-behave-table'"
  (let* ((elt (assoc action folding-behave-table)))
    (if elt
        (funcall (nth 1 elt) event)
      (error "Folding mode (folding-act): Unknown action %s" action))))

(defun folding-region-open-close (beg end &optional close)
  "Open all folds inside region BEG END. Close if optional CLOSE is non-nil."
  (interactive "r\nP")
  (let* ((func (if (null close)
                   'folding-show-current-entry
                 'folding-hide-current-entry))
         tmp)
    (save-excursion
      ;;   make sure the beg is first.
      (if (> beg end)                   ;swap order
          (setq  tmp beg  beg end   end tmp))
      (goto-char beg)
      (while (and
              ;;   the folding-show-current-entry/hide will move point
              ;;   to beg-of-line So we must move to the end of
              ;;   line to continue search.
              (if (and close
                       (eq 0 (folding-mark-look-at))) ;already closed ?
                  t
                (funcall func)
                (end-of-line)
                t)
              (folding-next-visible-heading)
              (< (point) end))))))

(defun fold-marks-kill ()
  "If over fold, open fold and kill beginning and end fold marker.
Return t ot nil if marks were removed."
  (interactive)
  (if (not (folding-mark-look-at))
      (when (called-interactively-p 'interactive)
        (message "Folding: Cursor not over fold. Can't remove fold marks.")
        nil)
    (destructuring-bind (beg end)
        (folding-show-current-entry)
      (let ((kill-whole-line t))
        ;;  must be done in this order, because point moves after kill.
        (goto-char end)
        (beginning-of-line)
        (kill-line)
        (goto-char beg)
        (beginning-of-line)
        (kill-line)
        ;; Return status
        t))))

(defun folding-hide-current-subtree ()
  "Call `folding-show-current-subtree' with argument 'hide."
  (interactive)
  (folding-show-current-subtree 'hide))

(defun folding-show-current-subtree (&optional hide)
  "Show or HIDE all folds inside current fold.
Point must be over beginning fold mark."
  (interactive "P")
  (let* ((stat  (folding-mark-look-at 'move))
         (beg   (point))
         end)
    (cond
     ((memq stat '(0 1 11))             ;It's BEG fold
      (when (eq 0 stat)                 ;it was closed
        (folding-show-current-entry)
        (goto-char beg))        ;folding-pick-move needs point at fold
      (save-excursion
        (if (folding-pick-move)
            (setq end (point))))
      (if (and beg end)
          (folding-region-open-close beg end hide)))
     (t
      (if (called-interactively-p 'interactive)
          (message "point is not at fold beginning."))))))

(defun folding-display-name ()
  "Show current active fold name."
  (interactive)
  (let* ((pos    (folding-find-folding-mark))
         name)
    (when pos
      (save-excursion
        (goto-char pos)
        (if (looking-at ".*[{]+")       ;Drop "{" mark away.
            (setq pos (match-end 0)))
        (setq name (buffer-substring
                    pos
                    (progn
                      (end-of-line)
                      (point))))))
    (if name
        (message (format "fold:%s" name)))))

;;}}}
;;{{{ code: events

(defun folding-event-posn (act event)
  "According to ACT read mouse EVENT struct and return data from it.
Event must be simple click, no dragging.

ACT
  'mouse-point  return the 'mouse cursor' point
  'window       return window pointer
  'col-row      return list (col row)"
  (cond
   ((not folding-xemacs-p)
    ;; short Description of FSF mouse event
    ;;
    ;; EVENT : (mouse-3 (# 128 (20 . 104) -23723628))
    ;; event-start : (# 128 (20 . 104) -23723628))
    ;;                                          ^^^MP
    ;; mp = mouse point
    (let* ((el (funcall (symbol-function 'event-start) event)))
      (cond
       ((eq act 'mouse-point)
        (nth 1 el))                     ;is there macro for this ?
       ((eq act 'window)
        (funcall (symbol-function 'posn-window) el))
       ((eq act 'col-row)
        (funcall (symbol-function 'posn-col-row) el))
       (t
        (error "Unknown request %s" act)))))
   (folding-xemacs-p
    (cond
     ((eq act 'mouse-point)
      (funcall (symbol-function 'event-point) event))
     ((eq act 'window)
      (funcall (symbol-function 'event-window) event))
     ;; Must be tested! (However, it's not used...)
     ((eq act 'col-row)
      (list (funcall (symbol-function 'event-x) event)
            (funcall (symbol-function 'event-y) event)))
     (t
      (error "Unknown request %s" act))))
   (t
    (error "This version of Emacs can't handle events."))))

(defmacro folding-interactive-spec-p ()
  "Preserve region during `interactive'.
In XEmacs user could also set `zmacs-region-stays'."
  (if folding-xemacs-p
      ;;  preserve selected region
      `'(interactive "_p")
    `'(interactive "p")))

(defmacro folding-mouse-yank-at-p ()
  "Check if user use \"yank at mouse point\" feature.

Please see the variable `folding-mouse-yank-at-point'."
  'folding-mouse-yank-at-point)

(defun folding-mouse-point (&optional event)
  "Return mouse's working point. Optional EVENT is mouse click.
When used on XEmacs, return nil if no character was under the mouse."
  (if (or (folding-mouse-yank-at-p)
          (null event))
      (point)
    (folding-event-posn 'mouse-point event)))

;;}}}

;;{{{ code: hook

(defmacro folding-find-file-hook ()
  "Return hook symbol for current version."
  `(if (boundp 'find-file-hook)
       'find-file-hook
     'find-file-hooks))

(defmacro folding-write-file-hook ()
  "Return hook symbol for current version."
  `(if (boundp 'write-file-functions)
       'write-file-functions
     'write-file-hooks))

(defun folding-is-hooked ()
  "Check if folding hooks are installed."
  (and (memq 'folding-mode-write-file
	     (symbol-value (folding-write-file-hook)))
       (memq 'folding-mode-find-file
	     (symbol-value (folding-find-file-hook)))))

;;;###autoload
(defun folding-uninstall-hooks ()
  "Remove hooks set by folding."
  (turn-off-folding-mode)
  (remove-hook 'finder-mode-hook 'folding-mode)
  (remove-hook 'write-file-hooks 'folding-mode-write-file)
  (remove-hook 'find-file-hooks  'folding-mode-find-file))

;;;###autoload
(defun folding-install-hooks ()
  "Install folding hooks."
  (folding-mode-add-find-file-hook)
  (add-hook 'finder-mode-hook 'folding-mode)
  (or (memq 'folding-mode-write-file (symbol-value (folding-write-file-hook)))
      (add-hook (folding-write-file-hook) 'folding-mode-write-file 'end)))

;;;###autoload
(defun folding-keep-hooked ()
  "Make sure hooks are in their places."
  (unless (folding-is-hooked)
    (folding-uninstall-hooks)
    (folding-install-hooks)))

;;}}}
;;{{{ code: Mouse handling

(defun folding-mouse-call-original (&optional event)
  "Execute original mouse function using mouse EVENT.

Do nothing if original function does not exist.

Does nothing when called by a function which has earlier been called
by us.

Sets global:
  `folding-calling-original'"
  (interactive "@e") ;; Was "e"
  ;; Without the following test we could easily end up in a endless
  ;; loop in case we would call a function which would call us.
  ;;
  ;; (An easy constructed example is to bind the function
  ;; `folding-mouse-context-sensitive' to the same mouse button both in
  ;; `folding-mode-map' and in the global map.)
  (if folding-calling-original
      nil
    ;; `folding-calling-original' is global
    (setq folding-calling-original t)
    (unwind-protect
        (progn
          (or event
              (setq event last-input-event))
          (let (mouse-key)
            (cond
             ((not folding-xemacs-p)
              (setq mouse-key (make-vector 1 (car-safe event))))
             (folding-xemacs-p
              (setq mouse-key
                    (vector
                     (append
                      (event-modifiers event)
                      (list (intern
                             (format "button%d"
                                     (funcall
                                      (symbol-function 'event-button)
                                      event))))))))
             (t
              (error "This version of Emacs can't handle events.")))
            ;; Test string: http://www.csd.uu.se/~andersl
            ;;              andersl A T csd uu se
            ;; (I have `ark-goto-url' bound to the same key as
            ;; this function.)
            ;;
            ;; turn off folding, so that we can see the real
            ;; function behind it.
            ;;
            ;; We have to restore the current buffer, otherwise the
            ;; let* won't be able to restore the old value of
            ;; folding-mode. In my environment, I have bound a
            ;; function which starts mail when I click on an e-mail
            ;; address. When returning, the current buffer has
            ;; changed.
            (let* ((folding-mode nil)
                   (orig-buf (current-buffer))
                   (orig-func (key-binding mouse-key)))
              ;; call only if exist
              (when orig-func
                ;; Check if the original function has arguments. If
                ;; it does, call it with the event as argument.
                (unwind-protect
                    (progn
                      (setq this-command orig-func)
                      (call-interactively orig-func))
;;; #untested, but included here for further reference
;;;                 (cond
;;;                  ((not (string-match "mouse" (symbol-name orig-func)))
;;;                   (call-interactively orig-func))
;;;                     ((string-match "^mouse" (symbol-name orig-func))
;;;                      (funcall orig-func event))
;;;                     (t
;;;                      ;;  Some other package's mouse command,
;;;                      ;;  should we do something special here for
;;;                      ;;  somebody?
;;;                      (funcall orig-func event)))
                  (set-buffer orig-buf))))))
      ;; This is always executed, even if the above generates an error.
      (setq folding-calling-original nil))))

(defun folding-mouse-context-sensitive (event)
  "Perform some operation depending on the context of the mouse pointer.
EVENT is mouse event.

The variable `folding-behave-table' contains a mapping between contexts and
operations to perform.

The following contexts can be handled (They are named after the
natural operation to perform on them):

    open   -   A folded fold.
    close  -   An open fold, which isn't the one current topmost one.
    up     -   The topmost visible fold.
    other  -   Anything else.

Note that the `pointer' can be either the buffer point, or the mouse
pointer depending in the setting of the user option
`folding-mouse-yank-at-point'."
  (interactive "e")
  (let* ( ;;  - Get mouse cursor point, or point
         (point (folding-mouse-point event))
         state)
    (if (null point)
        ;; The user didn't click on any text.
        (folding-act 'other event)
      (save-excursion
        (goto-char point)
        (setq state (folding-mark-look-at)))
      (cond
       ((eq state 0)
        (folding-act 'open event))
       ((eq state 1)
        (folding-act 'close event))
       ((eq state 11)
        (folding-act 'up event))
       ((eq 'end state)
        (folding-act 'close))
       ((eq state 'end-in)
        (folding-act 'up event))
       (t
        (folding-act 'other event))))))

;;; FIXME: #not used, the pick move handles this too
(defun folding-mouse-move (event)
  "Move down if sitting on fold mark using mouse EVENT.

Original function behind the mouse is called if no FOLD action wasn't
taken."
  (interactive "e")
  (let* ( ;;  - Get mouse cursor point, or point
         (point (folding-mouse-point event))
         state)
    (save-excursion
      (goto-char point)
      (beginning-of-line)
      (setq state (folding-mark-look-at)))
    (cond
     ((not (null state))
      (goto-char point)
      (folding-next-visible-heading) t)
     (t
      (folding-mouse-call-original event)))))

(defun folding-mouse-pick-move (event)
  "Pick movement if sitting on beg/end fold mark using mouse EVENT.
If mouse if at the `beginning-of-line' point, then always move up.

Original function behind the mouse is called if no FOLD action wasn't
taken."
  (interactive "e")
  (let* ( ;;  - Get mouse cursor point, or point
         (point (folding-mouse-point event))
         state)
    (save-excursion
      (goto-char point)
      (setq state (folding-mark-look-at)))
    (cond
     ((not (null state))
      (goto-char point)
      (if (= point
             (save-excursion (beginning-of-line) (point)))
          (folding-previous-visible-heading)
        (folding-pick-move)))
     (t
      (folding-mouse-call-original event)))))

;;}}}
;;{{{ code: engine

(defun folding-set-mode-line ()
  "Update modeline with fold level."
  (if (null folding-stack)
      (kill-local-variable 'folding-mode-string)
    (make-local-variable 'folding-mode-string)
    (setq folding-mode-string
          (if (eq 'folded (car folding-stack))
              (concat
               folding-inside-string "1" folding-inside-mode-name)
            (concat
             folding-inside-string
             (int-to-string (length folding-stack))
             folding-inside-mode-name)))))

(defun folding-clear-stack ()
  "Clear the fold stack, and release all the markers it refers to."
  (let ((stack folding-stack))
    (setq folding-stack nil)
    (while (and stack (not (eq 'folded (car stack))))
      (set-marker (car (car stack)) nil)
      (set-marker (cdr (car stack)) nil)
      (setq stack (cdr stack)))))

(defun folding-check-if-folding-allowed ()
  "Return non-nil when buffer allowed to be folded automatically.
When buffer is loaded it may not be desirable to fold it immediately,
because the file may be too large, or it may contain fold marks, that
really are not _real_ folds. (Eg. RMAIL saved files may have the
marks)

This function returns t, if it's okay to proceed checking the fold status
of file. Returning nil means that folding should not touch this file.

The variable `folding-check-allow-folding-function' normally contains this
function. Change the variable to use your own scheme."

  (or (let ((file (get 'find-file-noselect 'folding)))
        ;;  When a file reference is "pushed" is a C-h v buffer that says:
        ;;  test is a Lisp function in `~/foo/tmp/test.el' A flag gets set
        ;;  (see adviced code) and we must not fold this buffer, because
        ;;  it will be immediately searched.
        (and file
             (not (string-match (regexp-quote file)
                                (or buffer-file-name "")))))
      ;;  Do not fold these files
      (null (string-match folding-mode-hook-no-regexp (buffer-name)))))

(defun folding-mode-find-file ()
  "One of the funcs called whenever a `find-file' is successful.
It checks to see if `folded-file' has been set as a buffer-local
variable, and automatically starts Folding mode if it has.

This allows folded files to be automatically folded when opened.

To make this hook effective, the symbol `folding-mode-find-file-hook'
should be placed at the end of `find-file-hooks'. If you have
some other hook in the list, for example a hook to automatically
uncompress or decrypt a buffer, it should go earlier on in the list.

See also `folding-mode-add-find-file-hook'."
  (let* ((check-fold folding-check-folded-file-function)
         (allow-fold folding-check-allow-folding-function))
    ;;  Turn mode on only if it's allowed
    (if (funcall allow-fold)
        (or (and (and check-fold (funcall check-fold))
                 (folding-mode 1))
            (and (assq 'folded-file (buffer-local-variables))
                 folded-file
                 (folding-mode 1)
                 (kill-local-variable 'folded-file)))
      ;; In all other cases, unfold buffer.
      (if folding-mode
          (folding-mode -1)))))

;;;###autoload
(defun folding-mode-add-find-file-hook ()
  "Append `folding-mode-find-file-hook' to the list `find-file-hooks'.

This has the effect that afterwards, when a folded file is visited, if
appropriate Emacs local variable entries are recognized at the end of
the file, Folding mode is started automatically.

If `inhibit-local-variables' is non-nil, this will not happen regardless
of the setting of `find-file-hooks'.

To declare a file to be folded, put `folded-file: t' in the file's
local variables. eg., at the end of a C source file, put:

/*
Local variables:
folded-file: t
*/

The local variables can be inside a fold."
  (interactive)
  (or (memq 'folding-mode-find-file (symbol-value (folding-find-file-hook)))
      (add-hook (folding-find-file-hook) 'folding-mode-find-file 'end)))

(defun folding-mode-write-file ()
  "Folded files must be controlled by folding before saving.
This function turns on the folding mode if it is not activated.
It prevents 'binary pollution' upon save."
  (let* ((check-func  folding-check-folded-file-function)
         (no-re      folding-mode-hook-no-regexp)
         (bn         (or (buffer-name) "")))
    (if (and (not       (string-match no-re bn))
             (boundp    'folding-mode)
             (null      folding-mode)
             (and check-func (funcall check-func)))
        (progn
          ;;  When folding mode is turned on it also 'folds' whole
          ;;  buffer... can't avoid that, since it's more important
          ;;  to save safely
          (folding-mode 1)))
    ;; hook returns nil, good habit
    nil))

(defun folding-check-folded ()
  "Function to determine if this file is in folded form."
  (let* ( ;;  Could use folding-top-regexp , folding-bottom-regexp ,
         ;;  folding-regexp But they are not available at load time.
         (folding-re1 "^.?.?.?{{{")
         (folding-re2 "[\r\n].*}}}"))
    (save-excursion
      (goto-char (point-min))
      ;;  If we found both, we assume file is folded
      (and (re-search-forward folding-re1 nil t)
           ;; if file is folded, there are \r's
           (search-forward "\r" nil t)
           (re-search-forward folding-re2 nil t)))))

;;}}}

;;{{{ code: Folding mode

(defun folding-font-lock-keywords (&optional mode)
  "Return folding font-lock keywords for MODE."
  ;;  Add support mode-by-mode basis. Check if mode is already
  ;;  handled from the property list.
  (destructuring-bind (beg end ignore)
      (folding-get-mode-marks (or mode major-mode))
    ;; `ignore' is not used, add no-op for byte compiler
    (or ignore
	(setq ignore t))
    (setq beg (concat "^[ \t]*" (regexp-quote beg) "[^\r\n]+"))
    (setq end (concat "^[ \t]*" (regexp-quote end)))
    (list
     ;;  the `t' says to overwrite any previous highlight.
     ;;  => Needed because folding marks are in comments.
     (list beg 0 folding-font-lock-begin-mark  t)
     (list end 0 folding-font-lock-end-mark t))))

(defun folding-font-lock-support-instantiate (&optional mode)
  "Add fold marks with `font-lock-add-keywords'."
  (or mode
      (setq mode major-mode))
  ;;  Hide function from Byte Compiler.
  (let ((function 'font-lock-add-keywords))
    (when (fboundp function)
      (funcall function
               mode
               (folding-font-lock-keywords mode))
      ;; In order to see new keywords font lock must be restarted.
      (dolist (buffer (buffer-list))
        (with-current-buffer buffer
          (when (and (eq major-mode mode)
                     (or font-lock-mode
			 (and (boundp 'global-font-lock-mode)
			      global-font-lock-mode)))
            ;; FIXME: Crude fix. should we use font-lock-fontify-buffer instead?
            (font-lock-mode -1)
            (font-lock-mode 1)))))))

(defun folding-font-lock-support ()
  "Add font lock support."
  (let ((list (get 'folding-mode 'font-lock)))
    (unless (memq major-mode list)
      ;;  Support added, update known list
      (push major-mode list)
      (put 'folding-mode 'font-lock list)
      (folding-font-lock-support-instantiate major-mode))))

(defun folding-set-local-variables ()
  "Set local fold mark variables.
If you're going to change the beginning and end mark in
`folding-mode-marks-alist'; you must call this function."
  (set (make-local-variable 'folding-stack) nil)
  (make-local-variable 'folding-top-mark)
  (make-local-variable 'folding-secondary-top-mark)
  (make-local-variable 'folding-top-regexp)
  (make-local-variable 'folding-bottom-mark)
  (make-local-variable 'folding-bottom-regexp)
  (make-local-variable 'folding-regexp)
  (or (and (boundp 'folding-top-regexp)
           folding-top-regexp
           (boundp 'folding-bottom-regexp)
           folding-bottom-regexp)
      (let ((folding-marks (assq major-mode
                                 folding-mode-marks-alist)))
        (if folding-marks
            (setq folding-marks (cdr folding-marks))
          (setq folding-marks '("{{{" "}}}")))
        (apply 'folding-set-marks folding-marks))))

;;;###autoload
(defun turn-off-folding-mode ()
  "Turn off folding."
  (folding-mode -1))

;;;###autoload
(defun turn-on-folding-mode ()
  "Turn on folding."
  (folding-mode 1))

;;;###autoload
(defun folding-mode (&optional arg inter)
  "A folding-editor-like minor mode. ARG INTER.

These are the basic commands that Folding mode provides:

\\{folding-mode-map}

Keys starting with `folding-mode-prefix-key'

\\{folding-mode-prefix-map}

     folding-convert-buffer-for-printing:
     `\\[folding-convert-buffer-for-printing]'
     Makes a ready-to-print, formatted, unfolded copy in another buffer.

     Read the documentation for the above functions for more information.

Overview

    Folds are a way of hierarchically organizing the text in a file, so
    that the text can be viewed and edited at different levels. It is
    similar to Outline mode in that parts of the text can be hidden from
    view. A fold is a region of text, surrounded by special \"fold marks\",
    which act like brackets, grouping the text. Fold mark pairs can be
    nested, and they can have titles. When a fold is folded, the text is
    hidden from view, except for the first line, which acts like a title
    for the fold.

    Folding mode is a minor mode, designed to cooperate with many other
    major modes, so that many types of text can be folded while they are
    being edited (eg., plain text, program source code, Texinfo, etc.).

Folding-mode function

    If Folding mode is not called interactively (`(called-interactively-p 'interactive)' is nil),
    and it is called with two or less arguments, all of which are nil, then
    the point will not be altered if `folding-folding-on-startup' is set
    and `folding-whole-buffer' is called. This is generally not a good
    thing, as it can leave the point inside a hidden region of a fold, but
    it is required if the local variables set \"mode: folding\" when the
    file is first read (see `hack-local-variables').

    Not that you should ever want to, but to call Folding mode from a
    program with the default behavior (toggling the mode), call it with
    something like `(folding-mode nil t)'.

Fold marks

    For most types of folded file, lines representing folds have \"{{{\"
    near the beginning. To enter a fold, move the point to the folded line
    and type `\\[folding-shift-in]'. You should no longer be able to see
    the rest of the file, just the contents of the fold, which you couldn't
    see before. You can use `\\[folding-shift-out]' to leave a fold, and
    you can enter and exit folds to move around the structure of the file.

    All of the text is present in a folded file all of the time. It is just
    hidden. Folded text shows up as a line (the top fold mark) with \"...\"
    at the end. If you are in a fold, the mode line displays \"inside n
    folds Narrow\", and because the buffer is narrowed you can't see outside
    of the current fold's text.

    By arranging sections of a large file in folds, and maybe subsections
    in sub-folds, you can move around a file quickly and easily, and only
    have to scroll through a couple of pages at a time. If you pick the
    titles for the folds carefully, they can be a useful form of
    documentation, and make moving though the file a lot easier. In
    general, searching through a folded file for a particular item is much
    easier than without folds.

Managing folds

    To make a new fold, set the mark at one end of the text you want in the
    new fold, and move the point to the other end. Then type
    `\\[folding-fold-region]'. The text you selected will be made into a
    fold, and the fold will be entered. If you just want a new, empty fold,
    set the mark where you want the fold, and then create a new fold there
    without moving the point. Don't worry if the point is in the middle of
    a line of text, `folding-fold-region' will not break text in the middle
    of a line. After making a fold, the fold is entered and the point is
    positioned ready to enter a title for the fold. Do not delete the fold
    marks, which are usually something like \"{{{\" and \"}}}\". There may
    also be a bit of fold mark which goes after the fold title.

    If the fold markers get messed up, or you just want to see the whole
    unfolded file, use `\\[folding-open-buffer]' to unfolded the whole
    file, so you can see all the text and all the marks. This is useful for
    checking/correcting unbalanced fold markers, and for searching for
    things. Use `\\[folding-whole-file]' to fold the buffer again.

    `folding-shift-out' will attempt to tidy the current fold just before
    exiting it. It will remove any extra blank lines at the top and bottom,
    \(outside the fold marks). It will then ensure that fold marks exists,
    and if they are not, will add them (after asking). Finally, the number
    of blank lines between the fold marks and the contents of the fold is
    set to 1 (by default).

Folding package customizations

    If the fold marks are not set on entry to Folding mode, they are set to
    a default for current major mode, as defined by
    `folding-mode-marks-alist' or to \"{{{ \" and \"}}}\" if none are
    specified.

    To bind different commands to keys in Folding mode, set the bindings in
    the keymap `folding-mode-map'.

    The hooks `folding-mode-hook' and `-folding-hook' are
    called before folding the buffer and applying the key bindings in
    `folding-mode-map'. This is a good hook to set extra or different key
    bindings in `folding-mode-map'. Note that key bindings in
    `folding-mode-map' are only examined just after calling these hooks;
    new bindings in those maps only take effect when Folding mode is being
    started. The hook `folding-load-hook' is called when Folding mode is
    loaded into Emacs.

Mouse behavior

    If you want folding to detect point of actual mouse click, please see
    variable `folding-mouse-yank-at-p'.

    To customise the mouse actions, look at `folding-behave-table'."
  (interactive)

  (let ((new-folding-mode
         (if (not arg)
             (not folding-mode)
           (> (prefix-numeric-value arg) 0))))
    (or (eq new-folding-mode
            folding-mode)
        (if folding-mode
            (progn
              ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ progn ^^^
              ;; turn off folding
              (if (null (folding-use-overlays-p))
                  (setq selective-display nil))
              (folding-clear-stack)
              (folding-narrow-to-region nil nil)
              (folding-subst-regions (list 1 (point-max)) ?\r ?\n)

              ;; Restore "%n" (Narrow) in the mode line
              (setq mode-line-format
                    (mapcar
                     (function
                      (lambda (item)
                        (if (equal item 'folding-narrow-placeholder)
                            "%n" item)))
                     mode-line-format)))
          ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ else ^^^
          (cond
           ((folding-use-overlays-p)
            ;;  This may be Emacs specific; how about XEmacs?
            ;;
            ;; make line-move-ignore-invisible buffer local, matches
            ;; outline.el, and the 21 pre-release gets upset if this is
            ;; defined globally in shell buffer...
            (make-local-variable 'line-move-ignore-invisible)
            (setq  line-move-ignore-invisible t
                   buffer-invisibility-spec   '((t . t))))
           (t
            (setq selective-display t)
            (setq selective-display-ellipses t)))
          (unless (assq 'folding-mode minor-mode-alist)
            ;;  User has not run folding-install or he did call
            ;;  folding-uninstall which completely wiped package out.
            ;;  => anyway now he calls us, so be there for him
            (folding-install))
          (folding-keep-hooked)         ;set hooks if not there
          (widen)
          (setq folding-narrow-overlays nil)
          (folding-set-local-variables)
          (folding-font-lock-support)
          (unwind-protect
              (let ((hook-symbol (intern-soft
                                  (concat
                                   (symbol-name major-mode)
                                   "-folding-hook"))))
                (run-hooks 'folding-mode-hook)
                (and hook-symbol
                     (run-hooks hook-symbol)))
            (folding-set-mode-line))
          (and folding-folding-on-startup
               (if (or (called-interactively-p 'interactive)
                       arg
                       inter)
                   (folding-whole-buffer)
                 (save-excursion
                   (folding-whole-buffer))))
          (folding-narrow-to-region nil nil t)
          ;; Remove "%n" (Narrow) from the mode line
          (setq mode-line-format
                (mapcar
                 (function
                  (lambda (item)
                    (if (equal item "%n")
                        'folding-narrow-placeholder item)))
                 mode-line-format))))
    (setq folding-mode new-folding-mode)
    (if folding-mode
        (easy-menu-add folding-mode-menu)
      (easy-menu-remove folding-mode-menu))))

;;}}}
;;{{{ code: setting fold marks

;; You think those "\\(\\)" pairs are peculiar?  Me too. Emacs regexp
;; stuff has a bug; sometimes "\\(.*\\)" fails when ".*" succeeds, but
;; only in a folded file!  Strange bug!  Must check it out sometime.

(defun folding-set-marks (top bottom &optional secondary)
  "Set the folding top and bottom mark for the current buffer.

Input:

  TOP           The topmost fold mark. Comment start + fold begin string.
  BOTTOM        The bottom fold mark Comment end + fold end string.
  SECONDARY     Usually the comment end indicator for the mode. This
                is inserted by `folding-fold-region' after the fold top mark,
                and is presumed to be put after the title of the fold.

Example:

   html-mode:

      top: \"\"
      sec: \" -->\"

Notice that the top marker needs to be closed with SECONDARY comment end string.

Various regular expressions are set with this function, so don't set the
mark variables directly."
  (set (make-local-variable 'folding-top-mark)
       top)
  (set (make-local-variable 'folding-bottom-mark)
       bottom)
  (set (make-local-variable 'folding-secondary-top-mark)
       secondary)
  (set (make-local-variable 'folding-top-regexp)
       (concat "\\(^\\|\r+\\)[ \t]*"
               (regexp-quote folding-top-mark)))
  (set (make-local-variable 'folding-bottom-regexp)
       (concat "\\(^\\|\r+\\)[ \t]*"
               (regexp-quote folding-bottom-mark)))
  (set (make-local-variable 'folding-regexp)
       (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\("
               (regexp-quote folding-top-mark)
               "\\)\\|\\("
               (regexp-quote folding-bottom-mark)
               "[ \t]*\\(\\)\\($\\|\r\\)\\)\\)")))

;;}}}
;;{{{ code: movement

(defun folding-next-visible-heading (&optional direction)
  "Move up/down fold headers.
Backward if DIRECTION is non-nil returns nil if not moved = no next marker."
  (interactive)
  (let* ((begin-mark (nth 0 (folding-get-mode-marks)))
         case-fold-search)
    (if direction
        (re-search-backward (concat "^" (regexp-quote begin-mark)) nil t)
      (re-search-forward  (concat "^" (regexp-quote begin-mark)) nil t))))

(defun folding-previous-visible-heading ()
  "Move upward fold headers."
  (interactive)
  (beginning-of-line)
  (folding-next-visible-heading 'backward))

(defun folding-find-folding-mark (&optional end-fold)
  "Search backward to find beginning fold. Skips subfolds.
Optionally searches forward to find END-FOLD mark.

Return:

  nil
  point     position of fold mark"
  (let* (case-fold-search
         (elt   (folding-get-mode-marks))
         (bm    (regexp-quote (nth 0 elt))) ; markers defined for mode
         (em    (regexp-quote (nth 1 elt))) ; markers defined for mode
         (re    (concat "^" bm "\\|^" em))
         (count 0)
         stat
         moved)
    (save-excursion
      (cond
       (end-fold
        (folding-end-of-line)
        ;; We must skip over inner folds
        (while (and (null moved)
                    (re-search-forward re nil t))
          (setq stat (folding-mark-look-at))
          (cond
           ((symbolp stat)
            (setq count (1- count))
            (if (< count 0)           ;0 or less means no middle folds
                (setq moved t)))
           ((memq stat '(1 11))         ;BEG fold
            (setq count (1+ count)))))  ;; end while
        (when moved
          (forward-char -3)
          (setq moved (point))))
       (t
        (while (and (null moved)
                    (re-search-backward  re nil t))
          (setq stat (folding-mark-look-at))
          (cond
           ((memq stat '(1 11))
            (setq count (1- count))
            (if (< count 0)           ;0 or less means no middle folds
                (setq moved (point))))
           ((symbolp stat)
            (setq count (1+ count)))))
        (when moved                     ;What's the result
          (forward-char 3)
          (setq moved (point))))))
    moved))

(defun folding-pick-move ()
  "Pick the logical movement on fold mark.
If at the end of fold, then move to the beginning and vice versa.

If placed over closed fold moves to the next fold. When no next
folds are visible, stops moving.

Return:
 t      if moved"
  (interactive)
  (let* (case-fold-search
         (elt   (folding-get-mode-marks))
         (bm    (nth 0 elt))            ; markers defined for mode
         (stat  (folding-mark-look-at))
         moved)
    (cond
     ((eq 0 stat)                       ;closed fold
      (when (re-search-forward  (concat "^" (regexp-quote bm)) nil t)
        (setq moved t)
        (forward-char 3)))
     ((symbolp stat)                    ;End fold
      (setq moved (folding-find-folding-mark)))
     ((integerp stat)                   ;Beg fold
      (setq moved (folding-find-folding-mark 'end-fold))))
    (if (integerp moved)
        (goto-char moved))
    moved))

;;; Idea by Scott Evans 
(defun folding-context-next-action ()
  "Take next action according to point and context.
If point is at:

  Begin Fold  :  toggle open - close
  End Fold    :  close
  inside      :  fold current level."
  (interactive)
  (let ((state (folding-mark-look-at)))
    (cond
     ((eq state 0)
      (folding-act 'open))
     ((eq state 1)
      (folding-act 'close))
     ((eq state 11)
      (folding-act 'up))
     ((eq 'end state)
      (folding-act 'close))
     ((eq state 'end-in)
      (folding-act 'up))
     (t
      (folding-act 'other)))))

(defun folding-forward-char-1 (&optional arg)
  "See `folding-forward-char-1' for ARG."
  (if (eq arg 1)
      ;; Do it a faster way for arg = 1.
      (if (eq (following-char) ?\r)
          (let ((saved (point))
                (inhibit-quit t))
            (end-of-line)
            (if (not (eobp))
                (forward-char)
              (goto-char saved)
              (error "End of buffer")))
        ;; `forward-char' here will do its own error if (eobp).
        (forward-char))
    (if (> 0 (or arg (setq arg 1)))
        (folding-backward-char (- arg))
      (let (goal saved)
        (while (< 0 arg)
          (skip-chars-forward "^\r" (setq goal (+ (point) arg)))
          (if (eq goal (point))
              (setq arg 0)
            (if (eobp)
                (error "End of buffer")
              (setq arg (- goal 1 (point))
                    saved (point))
              (let ((inhibit-quit t))
                (end-of-line)
                (if (not (eobp))
                    (forward-char)
                  (goto-char saved)
                  (error "End of buffer"))))))))))

(defmacro folding-forward-char-macro ()
  `(defun folding-forward-char (&optional arg)
     "Move point right ARG characters, skipping hidden folded regions.
Moves left if ARG is negative. On reaching end of buffer, stop and
signal error."
     ,(folding-interactive-spec-p)
     ;; (folding-preserve-active-region)
     (folding-forward-char-1 arg)))

(folding-forward-char-macro)

(defun folding-backward-char-1 (&optional arg)
  "See `folding-backward-char-1' for ARG."
  (if (eq arg 1)
      ;; Do it a faster way for arg = 1.
      ;; Catch the case where we are in a hidden region, and bump into a \r.
      (if (or (eq (preceding-char) ?\n)
              (eq (preceding-char) ?\r))
          (let ((pos (1- (point)))
                (inhibit-quit t))
            (forward-char -1)
            (beginning-of-line)
            (skip-chars-forward "^\r" pos))
        (forward-char -1))
    (if (> 0 (or arg (setq arg 1)))
        (folding-forward-char (- arg))
      (let (goal)
        (while (< 0 arg)
          (skip-chars-backward "^\r\n" (max (point-min)
                                            (setq goal (- (point) arg))))
          (if (eq goal (point))
              (setq arg 0)
            (if (bobp)
                (error "Beginning of buffer")
              (setq arg (- (point) 1 goal)
                    goal (point))
              (let ((inhibit-quit t))
                (forward-char -1)
                (beginning-of-line)
                (skip-chars-forward "^\r" goal)))))))))

(defmacro folding-backward-char-macro ()
  `(defun folding-backward-char (&optional arg)
     "Move point right ARG characters, skipping hidden folded regions.
Moves left if ARG is negative. On reaching end of buffer, stop and
signal error."
     ,(folding-interactive-spec-p)
     ;; (folding-preserve-active-region)
     (folding-backward-char-1 arg)))

(folding-backward-char-macro)

(defmacro folding-end-of-line-macro ()
  `(defun folding-end-of-line (&optional arg)
     "Move point to end of current line, but before hidden folded region.
ARG is line count.

Has the same behavior as `end-of-line', except that if the current line
ends with some hidden folded text (represented by an ellipsis), the
point is positioned just before it. This prevents the point from being
placed inside the folded text, which is not normally useful."
     ,(folding-interactive-spec-p)
     ;;(interactive "p")
     ;; (folding-preserve-active-region)
     (if (or (eq arg 1)
             (not arg))
         (beginning-of-line)
       ;; `forward-line' also moves point to beginning of line.
       (forward-line (1- arg)))
     (skip-chars-forward "^\r\n")))

(folding-end-of-line-macro)

(defun folding-skip-ellipsis-backward ()
  "Move the point backwards out of folded text.

If the point is inside a folded region, the cursor is displayed at the
end of the ellipsis representing the folded part. This function checks
to see if this is the case, and if so, moves the point backwards until
it is just outside the hidden region, and just before the ellipsis.

Returns t if the point was moved, nil otherwise."
  (interactive)
  (let ((pos (point))
        result)
    (save-excursion
      (beginning-of-line)
      (skip-chars-forward "^\r" pos)
      (or (eq pos (point))
          (setq pos (point)
                result t)))
    (goto-char pos)
    result))

;;}}}

;;{{{ code: Moving in and out of folds

;;{{{ folding-shift-in

(defun folding-shift-in (&optional noerror)
  "Open and enter the fold at or around the point.

Enters the fold that the point is inside, wherever the point is inside
the fold, provided it is a valid fold with balanced top and bottom
marks. Returns nil if the fold entered contains no sub-folds, t
otherwise. If an optional argument NOERROR is non-nil, returns nil if
there are no folds to enter, instead of causing an error.

If the point is inside a folded, hidden region (as represented by an
ellipsis), the position of the point in the buffer is preserved, and as
many folds as necessary are entered to make the surrounding text
visible. This is useful after some commands eg., search commands."
  (interactive)
  (labels
      ((open-fold nil
                  (let ((data (folding-show-current-entry noerror t)))
                    (and data
                         (progn
                           (when folding-narrow-by-default
                             (setq folding-stack
                                   (if folding-stack
                                       (cons (cons (point-min-marker)
						   (point-max-marker))
                                             folding-stack)
                                     '(folded)))
                             (folding-set-mode-line))
                           (folding-narrow-to-region
			    (car data)
			    (nth 1 data)))))))
    (let ((goal (point)))
      (while (folding-skip-ellipsis-backward)
        (beginning-of-line)
        (open-fold)
        (goto-char goal))
      (if folding-narrow-by-default
          (open-fold)
	(widen)))))

;;}}}
;;{{{ folding-shift-out

(defun folding-shift-out (&optional event)
  "Exits the current fold with EVENT."
  (interactive)
  (if folding-stack
      (progn
        (folding-tidy-inside)
        (cond
         ((folding-use-overlays-p)
          (folding-subst-regions
           (list (overlay-end (car folding-narrow-overlays))
                 (overlay-start (cdr folding-narrow-overlays))) ?\n ?\r)
          ;; So point is correct in other windows.
          (goto-char (overlay-end (car folding-narrow-overlays))))
         (t
          (folding-subst-regions (list (point-min) (point-max)) ?\n ?\r)
          ;; So point is correct in other window
          (goto-char (point-min))))

        (if (eq (car folding-stack) 'folded)
            (folding-narrow-to-region nil nil t)
          (folding-narrow-to-region
	   (marker-position (car (car folding-stack)))
	   (marker-position (cdr (car folding-stack))) t))
        (and (consp (car folding-stack))
             (set-marker (car (car folding-stack)) nil)
             (set-marker (cdr (car folding-stack)) nil))
        (setq folding-stack (cdr folding-stack)))
    (error "Outside all folds"))
  (folding-set-mode-line))

;;}}}
;;{{{ folding-show-current-entry

(defun folding-show-current-entry (&optional event noerror noskip)
  "Opens the fold that the point is on, but does not enter it.
EVENT and optional arg NOERROR means don't signal an error if there is
no fold, just return nil. NOSKIP means don't jump out of a hidden
region first.

Returns ((START END SUBFOLDS-P). START and END indicate the extents of
the fold that was shown. If SUBFOLDS-P is non-nil, the fold contains
subfolds."
  (interactive)
  (or noskip
      (folding-skip-ellipsis-backward))
  (let ((point (point))
        backward
	forward
	start
	end
	subfolds-not-p)
    (unwind-protect
        (or (and (integerp
                  (car-safe (setq backward (folding-skip-folds t))))
                 (integerp
                  (car-safe (setq forward (folding-skip-folds nil))))
                 (progn
                   (goto-char (car forward))
                   (skip-chars-forward "^\r\n")
                   (setq end (point))
                   (skip-chars-forward "\r\n")
                   (not (and folding-stack (eobp))))
                 (progn
                   (goto-char (car backward))
                   (skip-chars-backward "^\r\n")
                   (setq start (point))
                   (skip-chars-backward "\r\n")
                   (not (and folding-stack (bobp))))
                 (progn
                   (setq point start)
                   ;; Avoid holding the list through a GC.
                   (setq subfolds-not-p
                         (not (or (cdr backward)
                                  (cdr forward))))
                   (folding-subst-regions
                    (append backward (nreverse forward))
                    ?\r ?\n)
		   ;;  FIXME: this should be moved to font-lock:
		   ;;  - When fold is closed, the whole line (with code)
		   ;;    is treated as comment
		   ;;  - Fon-lock changes all fonts to `font-lock-comment-face'
		   ;;  - When you again open fold, all text is in color
		   ;;
		   ;;  => Font lock should stop at \r, and not use ".*"
		   ;;     which includes \r character
		   ;;  This is a workaround, not an efficient one
		   (if (or (and (boundp 'global-font-lock-mode)
				global-font-lock-mode)
			   font-lock-mode)
		       (font-lock-fontify-region start end))
                   (list start end (not subfolds-not-p))))
            (if noerror
                nil
              (error "Not on a fold")))
      (goto-char point))))

;;}}}
;;{{{ folding-hide-current-entry

(defun folding-toggle-enter-exit ()
  "Run `folding-shift-in' or `folding-shift-out'.
This depends on current line's contents."
  (interactive)
  (beginning-of-line)
  (let ((current-line-mark (folding-mark-look-at)))
    (if (and (numberp current-line-mark)
             (= current-line-mark 0))
        (folding-shift-in)
      (folding-shift-out))))

(defun folding-toggle-show-hide ()
  "Run folding-show-current-entry or folding-hide-current-entry depending on current line's contents."
  (interactive)
  (beginning-of-line)
  (let ((current-line-mark (folding-mark-look-at)))
    (if (and (numberp current-line-mark)
             (= current-line-mark 0))
        (folding-show-current-entry)
      (folding-hide-current-entry))))

(defun folding-hide-current-entry (&optional event)
  "Close the fold around the point using EVENT.
Undo effect of `folding-show-current-entry'."
  (interactive)
  (folding-skip-ellipsis-backward)
  (let (start end)
    (if (and (integerp (setq start (car-safe (folding-skip-folds t))))
             (integerp (setq end (car-safe (folding-skip-folds nil)))))
        (if (and folding-stack
                 (or (eq start (point-min))
                     (eq end (point-max))))
            ;;(error "Cannot hide current fold")
            (folding-shift-out)
          (goto-char start)
          (skip-chars-backward "^\r\n")
          (folding-subst-regions (list start end) ?\n ?\r))
      (error "Not on a fold"))))

;;}}}
;;{{{ folding-show-all

(defun folding-show-all ()
  "Exits all folds, to the top level."
  (interactive)
  (while folding-stack
    (folding-shift-out)))

;;}}}
;;{{{ folding-goto-line

(defun folding-goto-line (line)
  "Go to LINE, entering as many folds as possible."
  (interactive "NGoto line: ")
  (folding-show-all)
  (goto-char 1)
  (and (< 1 line)
       (re-search-forward "[\n\C-m]" nil 0 (1- line)))
  (let ((goal (point)))
    (while (prog2 (beginning-of-line)
               (folding-shift-in t)
             (goto-char goal))))
  (folding-narrow-to-region
   (and folding-narrow-by-default (point-min))
   (point-max) t))

;;}}}

;;}}}
;;{{{ code: Searching for fold boundaries

;;{{{ folding-skip-folds

(defun folding-skip-folds (backward &optional outside)
  "Skips forward through the buffer (backward if BACKWARD is non-nil)
until it finds a closing fold mark or the end of the buffer. The
point is not moved. Jumps over balanced folding-mark pairs on the way.
Returns t if the end of buffer was found in an unmatched folding-mark
pair, otherwise a list.

If the point is actually on an fold start mark, the mark is ignored;
if it is on an end mark, the mark is noted. This decision is
reversed if BACKWARD is non-nil. If optional OUTSIDE is non-nil and
BACKWARD is nil, either mark is noted.

The first element of the list is a position in the end of the closing
fold mark if one was found, or nil. It is followed by (END START)
pairs (flattened, not a list of pairs). The pairs indicating the
positions of folds skipped over; they are positions in the fold
marks, not necessarily at the ends of the fold marks. They are in
the opposite order to that in which they were skipped. The point is
left in a meaningless place. If going backwards, the pairs are
\(START END) pairs, as the fold marks are scanned in the opposite
order.

Works by maintaining the position of the top and bottom marks found
so far. They are found separately using a normal string search for
the fixed part of a fold mark (because it is faster than a regexp
search if the string does not occur often outside of fold marks),
checking that it really is a proper fold mark, then considering the
earliest one found. The position of the other (if found) is
maintained to avoid an unnecessary search at the next iteration."
  (let ((first-mark (if backward folding-bottom-mark folding-top-mark))
        (last-mark  (if backward folding-top-mark    folding-bottom-mark))
        (top-re     folding-top-regexp)
        (depth 0)
        pairs point
        temp
        start
        first
        last
        case-fold-search)
    ;; Ignore trailing space?
    (when nil
      (when (and (stringp first-mark)
                 (string-match "^\\(.*[^ ]+\\) +$"  first-mark))
        (setq first-mark (match-string 1 first-mark)))
      (when (and (stringp last-mark)
                 (string-match "^\\(.*[^ ]+\\) +$"  last-mark))
        (setq last-mark (match-string 1 last-mark)))
      (when (and (stringp top-re)
                 (string-match "^\\(.*[^ ]+\\) +$"  top-re))
        (setq top-re (match-string 1 top-re))))
    (save-excursion
      (skip-chars-backward "^\r\n")
      (unless outside
        (and (eq (preceding-char) ?\r)
             (forward-char -1))
        (if (looking-at top-re)
            (if backward
                (setq last (match-end 1))
              (skip-chars-forward "^\r\n"))))
      (while (progn
               ;;  Find last first, prevents unnecessary searching
               ;;  for first.
               (setq point (point))
               (or last
                   (while (and (if backward
                                   (search-backward last-mark first t)
                                 (search-forward  last-mark first t))
                               (progn
                                 (setq temp (point))
                                 (goto-char (match-beginning 0))
                                 (skip-chars-backward " \t")
                                 (and (not
                                       (setq last
                                             (if (eq (preceding-char) ?\r)
                                                 temp
                                               (and (bolp) temp))))
                                      (goto-char temp)))))
                   (goto-char point))
               (or first
                   (while (and (if backward
                                   (search-backward first-mark last t)
                                 (search-forward  first-mark last t))
                               (progn
                                 (setq temp (point))
                                 (goto-char (match-beginning 0))
                                 (skip-chars-backward " \t")
                                 (and (not
                                       (setq first
                                             (if (eq (preceding-char) ?\r)
                                                 temp
                                               (and (bolp) temp))))
                                      (goto-char temp))))))
               ;;  Return value of conditional says whether to
               ;;  iterate again.
               (if (not last)
                   ;;  Return from this with the result.
                   (not (setq pairs (if first t (cons nil pairs))))
                 (if (and first
                          (if backward
                              (> first last)
                            (< first last)))
                     (progn
                       (goto-char first)
                       (if (eq 0 depth)
                           (setq start first
                                 first nil
                                 depth 1) ;; non-nil value, loop again.
                         (setq first nil
                               ;; non-nil value => loop again
                               depth (1+ depth))))
                   (goto-char last)
                   (if (eq 0 depth)
                       (not (setq pairs (cons last pairs)))
                     (or (< 0 (setq depth (1- depth)))
                         (setq pairs (cons last (cons start pairs))))
                     (setq last nil)
                     t)))))
      pairs)))

;;}}}

;;}}}
;;{{{ code: Functions that actually modify the buffer

;;{{{ folding-fold-region

(defun folding-fold-region (start end)
  "Places fold mark at the beginning and end of a specified region.
The region is specified by two arguments START and END. The point is
left at a suitable place ready to insert the title of the fold.

The fold markers are intended according to mode."
  (interactive "r")
  (and (< end start)
       (setq start (prog1 end
                     (setq end start))))
  (setq end (set-marker (make-marker) end))
  (goto-char start)
  (beginning-of-line)
  (setq start (point))
  (insert-before-markers folding-top-mark)
  ;;  XEmacs latex-mode, after (tex-site), indents the whole
  ;;  fold 50 characters right. Don't do that.
  (unless (string-match "latex" (symbol-name major-mode))
    (indent-according-to-mode))
  (let ((saved-point (point)))
    (and folding-secondary-top-mark
         (insert-before-markers folding-secondary-top-mark))
    (insert-before-markers ?\n)
    (goto-char (marker-position end))
    (set-marker end nil)
    (and (not (bolp))
         (eq 0 (forward-line))
         (eobp)
         (insert ?\n))
    (insert folding-bottom-mark)
    (unless (string-match "latex" (symbol-name major-mode))
      (indent-according-to-mode))
    (insert ?\n)
    (setq folding-stack (if folding-stack
                            (cons (cons (point-min-marker)
                                        (point-max-marker))
                                  folding-stack)
                          '(folded)))
    (folding-narrow-to-region start (1- (point)))
    (goto-char saved-point)
    (folding-set-mode-line))
  (save-excursion (folding-tidy-inside)))

;;}}}
;;{{{ folding-tidy-inside

;; Note to self: The long looking code for checking and modifying those
;; blank lines is to make sure the text isn't modified unnecessarily.
;; Don't remove it again!

(defun folding-tidy-inside ()
  "Add or remove blank lines at the top and bottom of the current fold.
Also adds fold marks at the top and bottom (after asking), if they are not
there already. The amount of space left depends on the variable
`folding-internal-margins', which is one by default."
  (interactive)
  (if buffer-read-only nil
    (let ()
;;;          (top-re       (if (string-match "^\\(.*\\) $"  folding-top-mark)
;;;                            (match-string 1 folding-top-mark)
;;;                          folding-top-mark))
      (if (folding-use-overlays-p)
          (goto-char (- (overlay-end (car folding-narrow-overlays)) 1))
        (goto-char (point-min)))
      (and (eolp)
           (progn (skip-chars-forward "\n\t ")
                  (delete-region (point-min) (point))))
      (and (if (let (case-fold-search) (folding-mark-look-at-top-mark-p))
               (progn (forward-line 1)
                      (and (eobp) (insert ?\n))
                      t)
             (and (y-or-n-p "Insert missing folding-top-mark? ")
                  (progn (insert (concat folding-top-mark
                                         ""
                                         (or folding-secondary-top-mark "")
                                         "\n"))
                         t)))
           folding-internal-margins
           (<= 0 folding-internal-margins)
           (let* ((p1 (point))
                  (p2 (progn (skip-chars-forward "\n") (point)))
                  (p3 (progn (skip-chars-forward "\n\t ")
                             (skip-chars-backward "\t " p2) (point))))
             (if (eq p2 p3)
                 (or (eq p2 (setq p3 (+ p1 folding-internal-margins)))
                     (if (< p2 p3)
                         (newline (- p3 p2))
                       (delete-region p3 p2)))
               (delete-region p1 p3)
               (or (eq 0 folding-internal-margins)
                   (newline folding-internal-margins)))))
      (if (folding-use-overlays-p)
          (goto-char  (overlay-start (cdr folding-narrow-overlays)))
        (goto-char (point-max)))
      (and (bolp)
           (progn (skip-chars-backward "\n")
                  (delete-region (point) (point-max))))
      (beginning-of-line)
      (and (or (let (case-fold-search) (folding-mark-look-at-bottom-mark-p))
               (progn (goto-char (point-max)) nil)
               (and (y-or-n-p "Insert missing folding-bottom-mark? ")
                    (progn
                      (insert (concat "\n" folding-bottom-mark))
                      (beginning-of-line)
                      t)))
           folding-internal-margins
           (<= 0 folding-internal-margins)
           (let* ((p1 (point))
                  (p2 (progn (skip-chars-backward "\n") (point)))
                  (p3 (progn (skip-chars-backward "\n\t ")
                             (skip-chars-forward "\t " p2) (point))))
             (if (eq p2 p3)
                 (or (eq p2 (setq p3 (- p1 1 folding-internal-margins)))
                     (if (> p2 p3)
                         (newline (- p2 p3))
                       (delete-region p2 p3)))
               (delete-region p3 p1)
               (newline (1+ folding-internal-margins))))))))

;;}}}

;;}}}
;;{{{ code: Operations on the whole buffer

;;{{{ folding-whole-buffer

(defun folding-whole-buffer ()
  "Folds every fold in the current buffer.
Fails if the fold markers are not balanced correctly.

If the buffer is being viewed in a fold, folds are repeatedly exited to
get to the top level first (this allows the folds to be tidied on the
way out). The buffer modification flag is not affected, and this
function will work on read-only buffers."

  (interactive)
  (message "Folding buffer...")
  (let ((narrow-min (point-min))
        (narrow-max (point-max))
        folding-list)
    (save-excursion
      (widen)
      (goto-char 1)
      (setq folding-list (folding-skip-folds nil t))
      (narrow-to-region narrow-min narrow-max)
      (and (eq t folding-list)
           (error
            "Cannot fold whole buffer -- unmatched begin-fold mark `%s' `%s'"
            (current-buffer)
            folding-top-mark))
      (and (integerp (car folding-list))
           (error
            "Cannot fold whole buffer -- extraneous end-fold mark `%s' `%s'"
            (current-buffer)
            folding-bottom-mark))
      (folding-show-all)
      (widen)
      (goto-char 1)
      ;; Do the modifications forwards.
      (folding-subst-regions (nreverse (cdr folding-list)) ?\n ?\r))
    (beginning-of-line)
    (folding-narrow-to-region nil nil t)
    (message "Folding buffer... done")))

;;}}}
;;{{{ folding-open-buffer

(defun folding-open-buffer ()
  "Unfolds the entire buffer, leaving the point where it is.
Does not affect the buffer-modified flag, and can be used on read-only
buffers."
  (interactive)
  (message "Unfolding buffer...")
  (folding-clear-stack)
  (folding-set-mode-line)
  (unwind-protect
      (progn
        (widen)
        (folding-subst-regions (list 1 (point-max)) ?\r ?\n))
    (folding-narrow-to-region nil nil t))
  (message "Unfolding buffer... done"))

;;}}}
;;{{{ folding-convert-buffer-for-printing

(defun folding-convert-buffer-for-printing (&optional buffer pre-title post-title pad)
  "Remove folds from a buffer, for printing.

It copies the contents of the (hopefully) folded buffer BUFFER into a
buffer called `*Unfolded: *', removing all of the fold
marks. It keeps the titles of the folds, however, and numbers them.
Subfolds are numbered in the form 5.1, 5.2, 5.3 etc., and the titles are
indented to eleven characters.

It accepts four arguments. BUFFER is the name of the buffer to be
operated on, or a buffer. nil means use the current buffer. PRE-TITLE
is the text to go before the replacement fold titles, POST-TITLE is the
text to go afterwards. Finally, if PAD is non-nil, the titles are all
indented to the same column, which is eleven plus the length of
PRE-TITLE. Otherwise just one space is placed between the number and
the title."
  (interactive (list (read-buffer "Remove folds from buffer: "
                                  (buffer-name)
                                  t)
                     (read-string "String to go before enumerated titles: ")
                     (read-string "String to go after enumerated titles: ")
                     (y-or-n-p "Pad section numbers with spaces? ")))
  (set-buffer (setq buffer (get-buffer buffer)))
  (setq pre-title (or pre-title "")
        post-title (or post-title ""))
  (or folding-mode
      (error "Must be in Folding mode before removing folds"))
  (let* ((new-buffer (get-buffer-create (concat "*Unfolded: "
                                                (buffer-name buffer)
                                                "*")))
         (section-list '(1))
         (section-prefix-list '(""))

         (secondary-mark-length (length folding-secondary-top-mark))

         (secondary-mark folding-secondary-top-mark)
         (mode major-mode)

         ;;  [jari] Aug 14 1997
         ;;  Regexp doesn't allow "footer text" like, so we add one more
         ;;  regexp to loosen the end criteria
         ;;
         ;;  {{{ Subsubsection 1
         ;;  }}} Subsubsection 1
         ;;
         ;;  was:  (regexp folding-regexp)
         ;;
         (regexp
          (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\("
                  (regexp-quote folding-top-mark)
                  "\\)\\|\\("
                  (regexp-quote folding-bottom-mark)
                  "[ \t]*.*\\(\\)\\($\\|\r\\)\\)\\)"))
         title
         prefix)
    ;;  was obsolete function: (buffer-flush-undo new-buffer)
    (buffer-disable-undo new-buffer)
    (save-excursion
      (set-buffer new-buffer)
      (delete-region (point-min)
                     (point-max)))
    (save-restriction
      (widen)
      (copy-to-buffer new-buffer (point-min) (point-max)))
    (display-buffer new-buffer t)
    (set-buffer new-buffer)
    (subst-char-in-region (point-min) (point-max) ?\r ?\n)
    (funcall mode)
    (while (re-search-forward regexp nil t)
      (if (match-beginning 4)
          (progn
            (goto-char (match-end 4))

            ;;  - Move after start fold and read the title from there
            ;;  - Then move back and kill the fold mark
            ;;
            (setq title
                  (buffer-substring (point)
                                    (progn (end-of-line)
                                           (point))))
            (delete-region (save-excursion
                             (goto-char (match-beginning 4))
                             (skip-chars-backward "\n\r")
                             (point))
                           (progn
                             (skip-chars-forward "\n\r")
                             (point)))
            (and (<= secondary-mark-length
                     (length title))
                 (string-equal secondary-mark
                               (substring title
                                          (- secondary-mark-length)))
                 (setq title (substring title
                                        0
                                        (- secondary-mark-length))))
            (setq section-prefix-list
                  (cons (setq prefix (concat (car section-prefix-list)
                                             (int-to-string (car section-list))
                                             "."))
                        section-prefix-list))
            (or (cdr section-list)
                (insert ?\n))
            (setq section-list (cons 1
                                     (cons (1+ (car section-list))
                                           (cdr section-list))))
            (setq title (concat prefix
                                (if pad
                                    (make-string
                                     (max 2 (- 8 (length prefix))) ? )
                                  " ")
                                title))
            (message "Reformatting: %s%s%s"
                     pre-title
                     title
                     post-title)
            (insert "\n\n"
                    pre-title
                    title
                    post-title
                    "\n\n"))
        (goto-char (match-beginning 5))
        (or (setq section-list (cdr section-list))
            (error "Too many bottom-of-fold marks"))

        (setq section-prefix-list (cdr section-prefix-list))
        (delete-region (point)
                       (progn
                         (forward-line 1)
                         (point)))))
    (and (cdr section-list)
         (error
          "Too many top-of-fold marks -- reached end of file prematurely"))
    (goto-char (point-min))
    (buffer-enable-undo)
    (set-buffer-modified-p nil)
    (message "All folds reformatted.")))

;;}}}
;;}}}

;;{{{ code: Standard fold marks for various major modes

;;{{{ A function to set default marks, `folding-add-to-marks-list'

(defun folding-add-to-marks-list (mode top bottom
                                       &optional secondary noforce message)
  "Add/set fold mark list for a particular major mode.
When called interactively, asks for a `major-mode' name, and for
fold marks to be used in that mode. It adds the new set to
`folding-mode-marks-alist', and if the mode name is the same as the current
major mode for the current buffer, the marks in use are also changed.

If called non-interactively, arguments are MODE, TOP, BOTTOM and
SECONDARY. MODE is the symbol for the major mode for which marks are
being set. TOP, BOTTOM and SECONDARY are strings, the three fold marks
to be used. SECONDARY may be nil (as opposed to the empty string), but
the other two must be non-empty strings, and is an optional argument.

Two other optional arguments are NOFORCE, meaning do not change the
marks if marks are already set for the specified mode if non-nil, and
MESSAGE, which causes a message to be displayed if it is non-nil. This
is also the message displayed if the function is called interactively.

To set default fold marks for a particular mode, put something like the
following in your .emacs:

\(folding-add-to-marks-list 'major-mode \"(** {{{ \" \"(** }}} **)\" \" **)\")

Look at the variable `folding-mode-marks-alist' to see what default settings
already apply.

`folding-set-marks' can be used to set the fold marks in use in the current
buffer without affecting the default value for a particular mode."
  (interactive
   (let* ((mode (completing-read
                 (concat "Add fold marks for major mode ("
                         (symbol-name major-mode)
                         "): ")
                 obarray
                 (function
                  (lambda (arg)
                    (and (commandp arg)
                         (string-match "-mode\\'"
                                       (symbol-name arg)))))
                 t))
          (mode (if (equal mode "")
                    major-mode
                  (intern mode)))
          (object (assq mode folding-mode-marks-alist))
          (old-top (and object
                        (nth 1 object)))
          top
          (old-bottom (and object
                           (nth 2 object)))
          bottom
          (secondary (and object
                          (nth 3 object)))
          (prompt "Top fold marker: "))
     (and (equal secondary "")
          (setq secondary nil))
     (while (not top)
       (setq top (read-string prompt (or old-top "{{{ ")))
       (and (equal top "")
            (setq top nil)))
     (setq prompt (concat prompt
                          top
                          ", Bottom marker: "))
     (while (not bottom)
       (setq bottom (read-string prompt (or old-bottom "}}}")))
       (and (equal bottom "")
            (setq bottom nil)))
     (setq prompt (concat prompt
                          bottom
                          (if secondary
                              ", Secondary marker: "
                            ", Secondary marker (none): "))
           secondary (read-string prompt secondary))
     (and (equal secondary "")
          (setq secondary nil))
     (list mode top bottom secondary nil t)))
  (let ((object (assq mode folding-mode-marks-alist)))
    (if (and object
             noforce
             message)
        (message "Fold markers for `%s' are already set."
                 (symbol-name mode))
      (if object
          (or noforce
              (setcdr object (if secondary
                                 (list top bottom secondary)
                               (list top bottom))))
        (setq folding-mode-marks-alist
              (cons (if secondary
                        (list mode top bottom secondary)
                      (list mode top bottom))
                    folding-mode-marks-alist)))
      (and message
           (message "Set fold marks for `%s' to \"%s\" and \"%s\"."
                    (symbol-name mode)
                    (if secondary
                        (concat top "name" secondary)
                      (concat top "name"))
                    bottom)
           (and (eq major-mode mode)
                (folding-set-marks top bottom secondary))))))

;;}}}
;;{{{ Set some useful default fold marks

(folding-add-to-marks-list 'ada-mode               "-- {{{" "-- }}}" nil t)
(folding-add-to-marks-list 'asm-mode               "; {{{"  "; }}}" nil t)
(folding-add-to-marks-list 'awk-mode               "# {{{"  "# }}}" nil t)
(folding-add-to-marks-list 'Bison-mode             "/* {{{" "/* }}} */" " */" t)
(folding-add-to-marks-list 'LaTeX-mode             "%{{{"   "%}}}" nil t)
(folding-add-to-marks-list 'TeX-mode               "%{{{"   "%}}}" nil t)
(folding-add-to-marks-list 'bibtex-mode            "%{{{"   "%}}} */" nil t)
(folding-add-to-marks-list 'bison-mode             "/* {{{" "/* }}} */" " */" t)
(folding-add-to-marks-list 'c++-mode               "// {{{" "// }}}" nil t)
(folding-add-to-marks-list 'c-mode                 "/* {{{" "/* }}} */" " */" t)
(folding-add-to-marks-list 'dcl-mode               "! {{{"  "! }}}" nil t)
(folding-add-to-marks-list 'change-log-mode        "{{{"    "}}}" nil t)
(folding-add-to-marks-list 'cperl-mode             "# {{{"  "# }}}" nil t)
(folding-add-to-marks-list 'emacs-lisp-mode        ";;{{{"  ";;}}}" nil t)
(folding-add-to-marks-list 'erlang-mode            "%%{{{"  "%%}}}" nil t)
(folding-add-to-marks-list 'finder-mode            "{{{"    "}}}" nil t)
(folding-add-to-marks-list 'fortran-mode           "! {{{"  "! }}}" nil t)
(folding-add-to-marks-list 'f90-mode               "! {{{"  "! }}}" nil t)
(folding-add-to-marks-list 'generic-mode           ";# "    ";\$" nil t)
(folding-add-to-marks-list 'gofer-mode             "-- {{{" "-- }}}" nil t)
(folding-add-to-marks-list 'html-mode   "" " -->" t)
(folding-add-to-marks-list 'icon-mode              "# {{{" "# }}}" nil t)
(folding-add-to-marks-list 'indented-text-mode     "{{{"    "}}}" nil t)
(folding-add-to-marks-list 'java-mode              "// {{{" "// }}}" nil t)
(folding-add-to-marks-list 'javascript-mode        "// {{{" "// }}}" nil t)
(folding-add-to-marks-list 'jde-mode               "// {{{" "// }}}" nil t)
(folding-add-to-marks-list 'ksh-mode               "# {{{"  "# }}}" nil t)
(folding-add-to-marks-list 'latex-mode             "%{{{"   "%}}}" nil t)
(folding-add-to-marks-list 'lisp-interaction-mode  ";;{{{"  ";;}}}" nil t)
(folding-add-to-marks-list 'lisp-mode              ";;{{{"  ";;}}}" nil t)
(folding-add-to-marks-list 'm4-mode                "# {{{" "# }}}" nil t)
(folding-add-to-marks-list 'makefile-mode          "# {{{"  "# }}}" nil t)
(folding-add-to-marks-list 'matlab-mode            "%%%{{{" "%%%}}}" nil t)
(folding-add-to-marks-list 'meta-mode              "% {{{" "% }}}" nil t)
(folding-add-to-marks-list 'ml-mode                "(* {{{" "(* }}} *)" " *)" t)
(folding-add-to-marks-list 'modula-2-mode          "(* {{{" "(* }}} *)" " *)" t)
(folding-add-to-marks-list 'nroff-mode             "\\\\ {{{" "\\\\ }}}" nil t)
(folding-add-to-marks-list 'occam-mode             "-- {{{" "-- }}}" nil t)
(folding-add-to-marks-list 'orwell-mode            "{{{"    "}}}" nil t)
(folding-add-to-marks-list 'pascal-mode            "{ ((( " "{ ))) }" " }" t)
(folding-add-to-marks-list 'php-mode               "// {{{" "// }}}" nil t)
(folding-add-to-marks-list 'perl-mode              "# {{{"  "# }}}" nil t)
(folding-add-to-marks-list 'plain-TeX-mode         "%{{{"   "%}}}" nil t)
(folding-add-to-marks-list 'plain-tex-mode         "%{{{"   "%}}}" nil t)
(folding-add-to-marks-list 'prolog-mode            "% {{{"   "% }}}" nil t)
(folding-add-to-marks-list 'python-mode            "# {{{"  "# }}}" nil t)
(folding-add-to-marks-list 'rexx-mode              "/* {{{" "/* }}} */" " */" t)
(folding-add-to-marks-list 'sh-mode                "# {{{"  "# }}}" nil t)
(folding-add-to-marks-list 'sh-script-mode         "# {{{"  "# }}}" nil t)
(folding-add-to-marks-list 'shellscript-mode       "# {{{"  "# }}}" nil t)
(folding-add-to-marks-list 'sgml-mode   "" " -->" t)
(folding-add-to-marks-list 'simula-mode            "! {{{"  "! }}}" nil t)
(folding-add-to-marks-list 'sml-mode               "(* {{{" "(* }}} *)" " *)" t)
(folding-add-to-marks-list 'sql-mode               "-- {{{"  "-- }}}" nil t)
(folding-add-to-marks-list 'tcl-mode               "#{{{"   "#}}}" nil t)
(folding-add-to-marks-list 'tex-mode               "%{{{"   "%}}}" nil t)
(folding-add-to-marks-list 'texinfo-mode   "@c {{{" "@c {{{endfold}}}" " }}}" t)
(folding-add-to-marks-list 'text-mode              "{{{"    "}}}" nil t)
(folding-add-to-marks-list 'vhdl-mode              "# {{{"  "# }}}" nil t)
(folding-add-to-marks-list 'xerl-mode              "%%{{{"  "%%}}}" nil t)
(folding-add-to-marks-list 'xrdb-mode              "! {{{"  "! }}}" nil t)

;; heavy shell-perl-awk programmer in fundamental-mode need # prefix...

(folding-add-to-marks-list 'fundamental-mode       "# {{{" "# }}}" nil t)

;;}}}

;;}}}

;;{{{ code: Gross, crufty hacks that seem necessary

;; ----------------------------------------------------------------------
;; The functions here have been tested with Emacs 18.55, Emacs 18.58,
;; Epoch 4.0p2 (based on Emacs 18.58) and XEmacs 19.6.

;; Note that XEmacs 19.6 can't do selective-display, and its
;; "invisible extents" don't work either, so Folding mode just won't
;; work with that version.

;; They shouldn't do the wrong thing with later versions of Emacs, but
;; they might not have the special effects either. They may appear to
;; be excessive; that is not the case. All of the peculiar things these
;; functions do is done to avoid some side-effect of Emacs' internal
;; logic that I have met. Some of them work around bugs or unfortunate
;; (lack of) features in Emacs. In most cases, it would be better to
;; move this into the Emacs C code.

;; Folding mode is designed to be simple to cooperate with as many
;; things as possible. These functions go against that principle at the
;; coding level, but make life for the user bearable.

;;{{{ folding-subst-regions

;; Substitute newlines for carriage returns or vice versa.
;; Avoid excessive file locking.

;; Substitutes characters in the buffer, even in a read-only buffer.
;; Takes LIST, a list of regions specified as sequence in the form
;; (START1 END1 START2 END2 ...). In every region specified by each
;; pair, substitutes each occurence of character FIND by REPLACE.

;; The buffer-modified flag is not affected, undo information is not
;; kept for the change, and the function works on read-only files. This
;; function is much more efficient called with a long sequence than
;; called for each region in the sequence.

;; If the buffer is not modified when the function is called, the
;; modified-flag is set before performing all the substitutions, and
;; locking is temporarily disabled. This prevents Emacs from trying to
;; make then delete a lock file for *every* substitution, which slows
;; folding considerably, especially on a slow networked filesystem.
;; Without this, on my system, folding files on startup (and reading
;; other peoples' folded files) takes about five times longer. Emacs
;; still locks the file once for this call under those circumstances; I
;; can't think of a way around that, but it isn't really a problem.

;; I consider these problems to be a bug in `subst-char-in-region'.

(defun folding-subst-regions (list find replace)
  "Substitute \\r and \\n using LIST FIND REPLACE."
  (let ((buffer-read-only   buffer-read-only) ;; Protect read-only flag.
        (modified           (buffer-modified-p))
        (font-lock-mode     nil)
        (lazy-lock-mode     nil)
        (overlay-p          (folding-use-overlays-p))
        (ask1 (symbol-function 'ask-user-about-supersession-threat))
        (ask2 (symbol-function 'ask-user-about-lock)))
    (if lazy-lock-mode ;; no-op: Byte compiler silencer
        (setq lazy-lock-mode t))
    (unwind-protect
        (progn
          (setq buffer-read-only nil)
          (or modified
              (progn
                (fset 'ask-user-about-supersession-threat
                      '(lambda (&rest x) nil))
                (fset 'ask-user-about-lock
                      '(lambda (&rest x) nil))
                (set-buffer-modified-p t))) ; Prevent file locking in the loop
          (while list
            (if overlay-p
                (folding-flag-region (car list) (nth 1 list) (eq find ?\n))
              (subst-char-in-region (car list) (nth 1 list) find replace t))
            (setq list (cdr (cdr list)))))
      ;; buffer-read-only is restored by the let.
      ;; Don't want to change MODIFF time if it was modified before.
      (or modified
          (unwind-protect
              (set-buffer-modified-p nil)
            (fset 'ask-user-about-supersession-threat ask1)
            (fset 'ask-user-about-lock ask2))))))

;;}}}
;;{{{ folding-narrow-to-region

;; Narrow to region, without surprising displays.

;; Similar to `narrow-to-region', but also adjusts window-start to be
;; the start of the narrowed region. If an optional argument CENTRE is
;; non-nil, the window-start is positioned to leave the point at the
;; centre of the window, like `recenter'. START may be nil, in which
;; case the function acts more like `widen'.

;; Actually, all the window-starts for every window displaying the
;; buffer, as well as the last_window_start for the buffer are set. The
;; points in every window are set to the point in the current buffer.
;; All this logic is necessary to prevent the display getting really
;; weird occasionally, even if there is only one window. Try making
;; this function like normal `narrow-to-region' with a touch of
;; `recenter', then moving around lots of folds in a buffer displayed in
;; several windows. You'll see what I mean.

;; last_window_start is set by making sure that the selected window is
;; displaying the current buffer, then setting the window-start, then
;; making the selected window display another buffer (which sets
;; last_window_start), then setting the selected window to redisplay the
;; buffer it displayed originally.

;; Note that whenever window-start is set, the point cannot be moved
;; outside the displayed area until after a proper redisplay. If this
;; is possible, centre the display on the point.

;; In Emacs 19; Epoch or XEmacs, searches all screens for all
;; windows. In Emacs 19, they are called "frames".

(defun folding-narrow-to-region (&optional start end centre)
  "Narrow to region START END, possibly CENTRE."
  (let* ((the-window        (selected-window))
         (selected-buffer   (window-buffer the-window))
         (window-ring       the-window)
         (window            the-window)
         (point             (point))
         (buffer            (current-buffer))
         temp)
    (unwind-protect
        (progn
          (unwind-protect
              (progn
                (if (folding-use-overlays-p)
                    (if start
                        (folding-narrow-aux  start end t)
                      (folding-narrow-aux  nil nil nil))
                  (if start
                      (narrow-to-region start end)
                    (widen)))

                (setq point (point))
                (set-window-buffer window buffer)

                (while (progn
                         (and (eq buffer (window-buffer window))
                              (if centre
                                  (progn
                                    (select-window window)
                                    (goto-char point)
                                    (vertical-motion
                                     (- (lsh (window-height window) -1)))
                                    (set-window-start window (point))
                                    (set-window-point window point))
                                (set-window-start window (or start 1))
                                (set-window-point window point)))

                         (not (eq (setq window (next-window window nil t))
                                  window-ring)))))
            nil                         ;; epoch screen
            (select-window the-window)) ;; unwind-protect INNER
          ;; Set last_window_start.
          (unwind-protect
              (if (not (eq buffer selected-buffer))
                  (set-window-buffer the-window selected-buffer)
                (if (get-buffer "*scratch*")
                    (set-window-buffer the-window (get-buffer "*scratch*"))
                  (set-window-buffer
                   the-window (setq temp (generate-new-buffer " *temp*"))))
                (set-window-buffer the-window buffer))
            (and temp
                 (kill-buffer temp))))
      ;; Undo this side-effect of set-window-buffer.
      (set-buffer buffer)
      (goto-char (point)))))

;;}}}

;;}}}

;;{{{ code: folding-end-mode-quickly

(defun folding-end-mode-quickly ()
  "Replace all ^M's with linefeeds and widen a folded buffer.
Only has any effect if Folding mode is active.

This should not in general be used for anything. It is used when changing
major modes, by being placed in kill-mode-tidy-alist, to tidy the buffer
slightly. It is similar to `(folding-mode 0)', except that it does not
restore saved keymaps etc. Repeat: Do not use this function. Its
behaviour is liable to change."
  (and (boundp 'folding-mode)
       (assq 'folding-mode
             (buffer-local-variables))
       folding-mode
       (progn
         (if (folding-use-overlays-p)
             (folding-narrow-to-region nil nil)
           (widen))
         (folding-clear-stack)
         (folding-subst-regions (list 1 (point-max)) ?\r ?\n))))

;;{{{ folding-eval-current-buffer-open-folds

(defun folding-eval-current-buffer-open-folds (&optional printflag)
  "Evaluate all of a folded buffer as Lisp code.
Unlike `eval-current-buffer', this function will evaluate all of a
buffer, even if it is folded. It will also work correctly on non-folded
buffers, so is a good candidate for being bound to a key if you program
in Emacs-Lisp.

It works by making a copy of the current buffer in another buffer,
unfolding it and evaluating it. It then deletes the copy.

Programs can pass argument PRINTFLAG which controls printing of output:
nil means discard it; anything else is stream for print."
  (interactive)
  (if (or (and (boundp 'folding-mode)
               folding-mode))
      (let ((temp-buffer
             (generate-new-buffer (buffer-name))))
        (message "Evaluating unfolded buffer...")
        (save-restriction
          (widen)
          (copy-to-buffer temp-buffer 1 (point-max)))
        (set-buffer temp-buffer)
        (subst-char-in-region 1 (point-max) ?\r ?\n)
        (let ((real-message-def (symbol-function 'message))
              (suppress-eval-message))
          (fset 'message
                (function
                 (lambda (&rest args)
                   (setq suppress-eval-message t)
                   (fset 'message real-message-def)
                   (apply 'message args))))
          (unwind-protect
              (eval-current-buffer printflag)
            (fset 'message real-message-def)
            (kill-buffer temp-buffer))
          (or suppress-eval-message
              (message "Evaluating unfolded buffer... Done"))))
    (eval-current-buffer printflag)))

;;}}}

;;}}}

;;{{{ code: ISearch support, walks in and out of folds

;; This used to be a package of it's own.
;; Requires Emacs 19 or XEmacs. Does not work under Emacs 18.

;;{{{ Variables

(defcustom folding-isearch-install t
  "*When non-nil, the isearch commands will handle folds."
  :type 'boolean
  :group 'folding)

(defvar folding-isearch-stack nil
  "Temporary storage for `folding-stack' during isearch.")

;; Lists of isearch commands to replace

;; These do normal searching.

(defvar folding-isearch-normal-cmds
  '(isearch-repeat-forward
    isearch-repeat-backward
    isearch-toggle-regexp
    isearch-toggle-case-fold
    isearch-delete-char
    isearch-abort
    isearch-quote-char
    isearch-other-control-char
    isearch-other-meta-char
    isearch-return-char
    isearch-exit
    isearch-printing-char
    isearch-whitespace-chars
    isearch-yank-word
    isearch-yank-line
    isearch-yank-kill
    isearch-*-char
    isearch-\|-char
    isearch-mode-help
    isearch-yank-x-selection
    isearch-yank-x-clipboard)
  "List if isearch commands doing normal search.")

;; Enables the user to edit the search string

;; Missing, present in XEmacs isearch-mode.el. Not necessary?
;; isearch-ring-advance-edit, isearch-ring-retreat-edit, isearch-complete-edit
;; isearch-nonincremental-exit-minibuffer, isearch-yank-x-selection,
;; isearch-yank-x-clipboard

(defvar folding-isearch-edit-enter-cmds
  '(isearch-edit-string
    isearch-ring-advance
    isearch-ring-retreat
    isearch-complete)              ; (Could also stay in search mode!)
  "List of isearch commands which enters search string edit.")

;; Continues searching after editing.

(defvar folding-isearch-edit-exit-cmds
  '(isearch-forward-exit-minibuffer     ; Exits edit
    isearch-reverse-exit-minibuffer
    isearch-nonincremental-exit-minibuffer)
  "List of isearch commands which exits search string edit.")

;;}}}
;;{{{ Keymaps (an Isearch hook)

(defvar folding-isearch-mode-map nil
  "Modified copy of the isearch keymap.")

;; Create local copies of the keymaps. The `isearch-mode-map' is
;; copied to `folding-isearch-mode-map' while `minibuffer-local-isearch-map'
;; is made local. (Its name is used explicitly.)
;;
;; Note: This is called every time the search is started.

(defun folding-isearch-hook-function ()
  "Update the isearch keymaps for usage with folding mode."
  (if (and (boundp 'folding-mode) folding-mode)
      (let ((cmds (append folding-isearch-normal-cmds
                          folding-isearch-edit-enter-cmds
                          folding-isearch-edit-exit-cmds)))
        (setq folding-isearch-mode-map (copy-keymap isearch-mode-map))
        (make-local-variable 'minibuffer-local-isearch-map)
        ;; Make sure the destructive operations below doesn't alter
        ;; the global instance of the map.
        (setq minibuffer-local-isearch-map
              (copy-keymap minibuffer-local-isearch-map))
        (setq folding-isearch-stack folding-stack)
        (while cmds
          (substitute-key-definition
           (car cmds)
           (intern (concat "folding-" (symbol-name (car cmds))))
           folding-isearch-mode-map)
          (substitute-key-definition
           (car cmds)
           (intern (concat "folding-" (symbol-name (car cmds))))
           minibuffer-local-isearch-map)
          (setq cmds (cdr cmds)))
        ;; Install our keymap
        (cond
         (folding-xemacs-p
          (let ((f 'set-keymap-name))
            (funcall f folding-isearch-mode-map 'folding-isearch-mode-map))
          ;; Later version of XEmacs (21.2+) use overriding-local-map
          ;; for isearch keymap rather than fiddling with
          ;; minor-mode-map-alist.  This is so isearch keymaps take
          ;; precedence over extent-local keymaps.  We will support
          ;; both ways here.  Keymaps will be restored as side-effect
          ;; of isearch-abort and isearch-quit
          (cond
           ;; if overriding-local-map is in use
           ((and (boundp 'overriding-local-map) overriding-local-map)
            (set-keymap-parent folding-isearch-mode-map overriding-local-map)
            (setq overriding-local-map folding-isearch-mode-map))
           ;; otherwise fiddle with minor-mode-map-alist
           (t
            (setq minor-mode-map-alist
                  (cons (cons 'isearch-mode folding-isearch-mode-map)
                        (delq (assoc 'isearch-mode minor-mode-map-alist)
                              minor-mode-map-alist))))))
         ((boundp 'overriding-terminal-local-map)
          (funcall (symbol-function 'set)
                   'overriding-terminal-local-map folding-isearch-mode-map))
         ((boundp 'overriding-local-map)
          (setq overriding-local-map folding-isearch-mode-map))))))

;; Undoes the `folding-isearch-hook-function' function.

(defun folding-isearch-end-hook-function ()
  "Actions to perform at the end of isearch in folding mode."
  (when (and (boundp 'folding-mode) folding-mode)
    (kill-local-variable 'minibuffer-local-isearch-map)
    (setq folding-stack folding-isearch-stack)))

(when folding-isearch-install
  (add-hook 'isearch-mode-hook 'folding-isearch-hook-function)
  (add-hook 'isearch-mode-end-hook 'folding-isearch-end-hook-function))

;;}}}
;;{{{ Normal search routines

;; Generate the replacement functions of the form:
;;    (defun folding-isearch-repeat-forward ()
;;      (interactive)
;;      (folding-isearch-general 'isearch-repeat-forward))

(let ((cmds folding-isearch-normal-cmds))
  (while cmds
    (eval
     `(defun ,(intern (concat "folding-" (symbol-name (car cmds))))
	nil
	"Automatically generated"
	(interactive)
	(folding-isearch-general (quote ,(car cmds)))))
    (setq cmds (cdr cmds))))

;; The HEART! Executes command and updates the foldings.
;; This is capable of detecting a `quit'.

(defun folding-isearch-general (function)
  "Execute isearch command FUNCTION and adjusts the folding."
  (let* ((quit-isearch  nil)
         (area-beg      (point-min))
         (area-end      (point-max))
         pos)
    (cond
     (t
      (save-restriction
        (widen)
        (condition-case nil
            (funcall function)
          (quit  (setq quit-isearch t)))
        (setq pos (point)))
      ;; Situation
      ;; o   user has folded buffer
      ;; o   He manually narrows, say to function !
      ;; --> there is no fold marks at the beg/end --> this is not a fold
      (condition-case nil
          ;; "current mode has no fold marks..."
          (folding-region-has-folding-marks-p area-beg area-end)
        (error (setq quit-isearch t)))
      (folding-goto-char pos)))
    (if quit-isearch
        (signal 'quit '(isearch)))))

;;}}}
;;{{{ Edit search string support

(defvar folding-isearch-current-buffer nil
  "The buffer we are editing, so we can widen it when in minibuffer.")

;; Functions which enters edit mode.

(defun folding-isearch-edit-string ()
  "Replace `isearch-edit-string' when in `folding-mode'."
  (interactive)
  (folding-isearch-start-edit 'isearch-edit-string))

(defun folding-isearch-ring-advance ()
  "Replace `isearch-ring-advance' when in `folding-mode'."
  (interactive)
  (folding-isearch-start-edit 'isearch-ring-advance))

(defun folding-isearch-ring-retreat ()
  "Replace `isearch-ring-retreat' when in `folding-mode'."
  (interactive)
  (folding-isearch-start-edit 'isearch-ring-retreat))

(defun folding-isearch-complete ()
  "Replace `isearch-complete' when in `folding-mode'."
  (interactive)
  (folding-isearch-start-edit 'isearch-complete))

;; Start and wait for editing. When (funcall fnk) returns
;; we are back in interactive search mode.
;;
;; Store match data!

(defun folding-isearch-start-edit (function)
  "Edit with function FUNCTION."
  (let (pos)
    (setq folding-isearch-current-buffer (current-buffer))
    (save-restriction
      (funcall function)
      ;; Here, we are widened, by folding-isearch-*-exit-minibuffer.
      (setq pos (point)))
    (folding-goto-char pos)))

;; Functions which exits edit mode.

;; The `widen' below will be caught by the `save-restriction' above, thus
;; this will not cripple `folding-stack'.

(defun folding-isearch-forward-exit-minibuffer ()
  "Replace `isearch-forward-exit-minibuffer' when in `folding-mode'."
  (interactive)
  ;; Make sure we can continue searching outside narrowing.
  (save-excursion
    (set-buffer folding-isearch-current-buffer)
    (widen))
  (isearch-forward-exit-minibuffer))

(defun folding-isearch-reverse-exit-minibuffer ()
  "Replace `isearch-reverse-exit-minibuffer' when in `folding-mode'."
  (interactive)
  ;; Make sure we can continue searching outside narrowing.
  (save-excursion
    (set-buffer folding-isearch-current-buffer)
    (widen))
  (isearch-reverse-exit-minibuffer))

(defun folding-isearch-nonincremental-exit-minibuffer ()
  "Replace `isearch-reverse-exit-minibuffer' when in `folding-mode'."
  (interactive)
  ;; Make sure we can continue searching outside narrowing.
  (save-excursion
    (set-buffer folding-isearch-current-buffer)
    (widen))
  (isearch-nonincremental-exit-minibuffer))

;;}}}
;;{{{ Special XEmacs support

;; In XEmacs, all isearch commands must have the property `isearch-command'.

(if folding-xemacs-p
    (let ((cmds (append folding-isearch-normal-cmds
                        folding-isearch-edit-enter-cmds
                        folding-isearch-edit-exit-cmds)))
      (while cmds
        (put (intern (concat "folding-" (symbol-name (car cmds))))
             'isearch-command t)
        (setq cmds (cdr cmds)))))

;;}}}
;;{{{ General purpose function.

(defun folding-goto-char (pos)
  "Goto character POS, changing fold if necessary."
  ;; Make sure POS is inside the visible area of the buffer.
  (goto-char pos)
  (if (eq pos (point))                  ; Point inside narrowed area?
      nil
    (folding-show-all)                 ; Fold everything and goto top.
    (goto-char pos))
  ;; Enter if point is folded.
  (if (folding-point-folded-p pos)
      (progn
        (folding-shift-in)      ; folding-shift-in can change the pos.
        (setq folding-isearch-stack folding-stack)
        (setq folding-stack '(folded))
        (goto-char pos))))

(defun folding-point-folded-p (pos)
  "Non-nil when POS is not visible."
  (if (folding-use-overlays-p)
      (let ((overlays (overlays-at (point)))
            (found nil))
        (while (and (not found) (overlayp (car overlays)))
          (setq found (overlay-get (car overlays) 'fold)
                overlays (cdr overlays)))
        found)
    (save-excursion
      (goto-char pos)
      (beginning-of-line)
      (skip-chars-forward "^\r" pos)
      (not (eq pos (point))))))

;;}}}

;;}}}
;;{{{ code: Additional functions

(defvar folding-comment-folding-table
  '((c-mode
     folding-comment-c-mode
     folding-uncomment-c-mode))
  "Table of functions to comment and uncomment folds.
Function is called with two arguments:

  number    start of fold mark
  marker    end of fold mark

Function must return:

  (beg . end)    start of fold, end of fold

Table Format:
 '((MAJOR-MODE COMMENT-FUNCTION UNCOMMENT-FUNCTION) ..)")

(defun folding-insert-advertise-folding-mode ()
  "Insert Small text describing where to the get the folding at point.
This may be useful 'banner' to inform other people why your code
is formatted like it is and how to view it correctly."
  (interactive)
  (let* ((prefix "")
         (re    (or comment-start-skip
                    (and comment-start
                         (concat "^[ \t]*" comment-start "+[ \t]*")))))

    (when re
      (save-excursion
        (beginning-of-line)
        (when (or (re-search-forward re nil t)
                  (progn
                    (goto-char (point-min))
                    (re-search-forward re nil t)))
          (setq prefix (match-string 0)))))

    (beginning-of-line)
    (dolist (line
             (list
              "File layout controlled by Emacs folding.el available at: "
              folding-package-url-location))
      (insert "\n" prefix line))))

(defun folding-uncomment-mode-generic (beg end tag)
  "In region (BEG . END) remove two TAG lines."
  (re-search-forward tag (marker-position end))
  (beginning-of-line)
  (kill-line 1)
  (re-search-forward tag (marker-position end))
  (beginning-of-line)
  (kill-line 1)
  (cons beg end))

(defun folding-comment-mode-generic (beg end tag1 &optional tag2)
  "Return (BEG . END) and Add two TAG1 and TAG2 lines."
  (insert tag1)
  (goto-char (marker-position end))
  (insert (or tag2 tag1))
  (cons beg end))

(defun folding-uncomment-c-mode  (beg end)
  "Uncomment region BEG END."
  (folding-uncomment-mode-generic
   beg end (regexp-quote " comment /* FOLDING -COM- */")))

(defun folding-comment-c-mode  (beg end)
  "Comment region BEG END."
  (let* ((tag " /* FOLDING -COM- */"))
    (folding-comment-mode-generic
     beg end
     (concat "#if comment"    tag "\n")
     (concat "#endif comment" tag "\n"))))

(defun folding-comment-fold  (&optional uncomment)
  "Comment or UNCOMMENT all text inside single fold.
If there are subfolds this function won't work as expected.
User must know that there are no subfolds.

The heading has -COM- at the end when the fold is commented.
Point must be over fold heading {{{ when function is called.

Note:

 You can use this function only in modes that do _not_ have
 `comment-end'. Ie. don't use this function in modes like C (/* */), because
 nested comments are not allowed. See this:

    /* {{{ fold */
       code  /* comment of the code */
    /* }}} */

 Fold can't know how to comment the `code' inside fold, because comments
 do not nest.

Implementation detail:

 {{{ FoldHeader-COM-

 If the fold header has -COM- at the end, then the fold is supposed to
 be commented. And if there is no -COM- then fold will be considered
 as normal fold. Do not loose or add the -COM- yourself or it will
 confuse the state of the fold.

References:

 `folding-comment-folding-table'"
  (interactive "P")
  (let* ((state     (folding-mark-look-at 'move))
         (closed    (eq 0 state))
         (id        "-COM-")
         (opoint    (point))
         (mode-elt  (assq major-mode folding-comment-folding-table))
         comment
         ret
         beg
         end)
    (unless mode-elt
      (if (stringp (nth 2 (folding-get-mode-marks major-mode)))
          (error "\
Folding: function usage error, mode with `comment-end' is not supported.")))
    (when (or (null comment-start)
              (not (string-match "[^ \t\n]" comment-start)))
      (error "Empty comment-start."))
    (unless (memq state '( 0 1 11))
      (error "Incorrect fold state. Point must be over {{{."))
    ;;  There is nothing to do if this fold heading does not have
    ;;  the ID when uncommenting the fold.
    (setq state (looking-at (concat ".*" id)))
    (when (or (and uncomment state)
              (and (null uncomment) (null state)))
      (when closed (save-excursion (folding-show-current-entry)))
      (folding-pick-move)               ;Go to end
      (beginning-of-line)
      (setq end (point-marker))
      (goto-char opoint)                ;And off the fold heading
      (forward-line 1)
      (setq beg (point))
      (setq comment (concat comment-start id))
      (cond
       (mode-elt
        (setq ret
              (if uncomment
                  (funcall (nth 2 mode-elt) (point) end)
                (funcall (nth 1 mode-elt) (point) end)))
        (goto-char (cdr ret)))
       (uncomment
        (while (< (point) (marker-position end))
          (if (looking-at comment)
              (delete-region (point) (match-end 0)))
          (forward-line 1)))
       (t
        (while (< (point) (marker-position end))
          (if (not (looking-at comment))
              (insert comment))
          (forward-line 1))))
      (setq end nil)                    ;kill marker
      ;;  Remove the possible tag from the fold name line
      (goto-char opoint)
      (setq id (concat (or comment-start "") id (or comment-end "")))
      (if (re-search-forward (regexp-quote id) beg t)
          (delete-region (match-beginning 0)  (match-end 0)))
      (when (null uncomment)
        (end-of-line)
        (insert id))
      (if closed
          (folding-hide-current-entry))
      (goto-char opoint))))

(defun folding-convert-to-major-folds ()
  "Convert fold mark items according to `major-mode'.
This function replaces all fold markings }}} and {{{
with major mode's fold marks.

As a side effect also corrects all foldings to standard notation.
Eg. following, where correct folding-beg should be \"#{{{ \"
Note that /// marks foldings.

  ///                  ;wrong fold
  #     ///           ;too many spaces, fold format error
  # ///title            ;ok, but title too close

  produces

  #///
  #///
  #/// title

You must 'unfold' whole buffer before using this function."
  (interactive)
  (let (case-fold-search
        (bm "{{{")                      ; begin match mark
        (em "}}}")                      ;
        el                              ; element
        b                               ; begin
        e                               ; end
        e2                              ; end2
        pp)
    (catch 'out                         ; is folding active/loaded ??
      (unless (setq el (folding-get-mode-marks major-mode))
        (throw 'out t))                 ; ** no mode found
      ;; ok , we're in business. Search whole buffer and replace.
      (setq b  (elt el 0)
            e  (elt el 1)
            e2 (or (elt el 2) ""))
      (save-excursion
        (goto-char (point-min))   ; start from the beginning of buffer
        (while (re-search-forward (regexp-quote bm) nil t)
          ;; set the end position for fold marker
          (setq pp (point))
          (beginning-of-line)
          (if (looking-at (regexp-quote b)) ; should be mode-marked; ok, ignore
              (goto-char pp)       ; note that beg-of-l cmd, move rexp
            (delete-region (point) pp)
            (insert b)
            (when (not (string= "" e2))
              (unless (looking-at (concat ".*" (regexp-quote e2)))
                ;; replace with right fold mark
                (end-of-line)
                (insert e2)))))
        ;; handle end marks , identical func compared to prev.
        (goto-char (point-min))
        (while (re-search-forward (regexp-quote em)nil t)
          (setq pp (point))
          (beginning-of-line)
          (if (looking-at (regexp-quote e))
              (goto-char pp)
            (delete-region (point) (progn (end-of-line) (point)))
            (insert e)))))))

(defun folding-all-comment-blocks-in-region (beg end)
  "Put all comments in folds inside BEG END.
Notice: Make sure there is no interfering folds inside the area,
because the results may and up corrupted.

This only works for modes that DO NOT have `comment-end'.
The `comment-start' must be left flushed in order to counted in.

After this

    ;; comment
    ;; comment

    code

    ;; comment
    ;; comment

    code

The result will be:

    ;; {{{ 1

    ;; comment
    ;; comment

    ;; }}}

    code

    ;; {{{ 2

    ;; comment
    ;; comment

    ;; }}}

    code"
  (interactive "*r")

  (unless comment-start
    (error "Folding: Mode does not define `comment-start'"))

  (when (and (stringp comment-end)
             (string-match "[^ \t]" comment-end))
    (error "Folding: Mode defines non-empty `comment-end'."))
  (let* ((count          0)
         (comment-regexp (concat "^" comment-start))
         (marker         (point-marker))
         done)
    (destructuring-bind (left right ignore)
        (folding-get-mode-marks)
      ;; Bytecomp silencer: variable ignore bound but not referenced
      (if ignore (setq ignore ignore))
      ;; %%%{{{  --> "%%%"
      (string-match (concat (regexp-quote comment-start) "+") left)
      (save-excursion
        (goto-char beg)
        (beginning-of-line)
        (while (re-search-forward comment-regexp nil t)
          (move-marker marker (point))
          (setq done nil)
          (beginning-of-line)
          (forward-line -1)
          ;; 2 previous lines Must not contain FOLD beginning already
          (unless (looking-at (regexp-quote left))
            (forward-line -1)
            (unless (looking-at (regexp-quote left))
              (goto-char (marker-position marker))
              (beginning-of-line)
              (insert  left " " (int-to-string count) "\n\n")
              (incf count)
              (setq done t)))
          (goto-char (marker-position marker))
          (when done
            ;; Try finding pat of the comment block
            (if (not (re-search-forward "^[ \t]*$" nil t))
                (goto-char end))
            (open-line 1)
            (forward-line 1)
            (insert right "\n")))))))

;;}}}
;;{{{ code: Overlay support

(defun folding-use-overlays-p ()
  "Should folding use overlays?."
  (if folding-allow-overlays
      (if folding-xemacs-p
          ;;  See if we can load overlay.el library that comes in 19.15
          ;;  This call returns t or nil if load was successful
          ;;  Note: is there provide statement? Load is so radical
          ;;
          (load "overlay" 'noerr)
        t)))

(defun folding-flag-region (from to flag)
  "Hide or show lines from FROM to TO, according to FLAG.
If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
  (let ((inhibit-read-only t)
        overlay)
    (save-excursion
      (goto-char from)
      (end-of-line)
      (cond
       (flag
        (setq overlay (make-overlay (point) to))
        (folding-make-overlay-hidden overlay))
       (t
        (if (fboundp 'hs-discard-overlays)
            (funcall (symbol-function 'hs-discard-overlays)
                     (point) to 'invisible t)))))))

(defun folding-make-overlay-hidden (overlay)
  "Make OVERLAY hidden."
  (overlay-put overlay  'fold t)
  ;;  (overlay-put overlay 'intangible t)
  (overlay-put overlay 'invisible t)
  (overlay-put overlay 'owner 'folding))

(defun folding-narrow-aux (start end arg)
  "Narrow. Make overlay from `point-min' to START.
And from END t `point-min'. If ARG is nil, delete overlays."
  (if (null arg)
      (cond
       (folding-narrow-overlays
        (delete-overlay (car folding-narrow-overlays))
        (delete-overlay (cdr folding-narrow-overlays))
        (setq folding-narrow-overlays nil)))
    (let ((overlay-beg (make-overlay (point-min) start))
          (overlay-end (make-overlay  end (point-max))))
      (overlay-put overlay-beg 'folding-narrow t)
      (overlay-put overlay-beg 'invisible t)
      (overlay-put overlay-beg 'owner 'folding)
      (overlay-put overlay-end 'folding-narrow t)
      (overlay-put overlay-end 'invisible t)
      (overlay-put overlay-end 'owner 'folding)
      (setq folding-narrow-overlays (cons overlay-beg  overlay-end)))))

;;}}}
;;{{{ code: end of file tag, provide

(folding-install)

(provide 'folding)
(provide 'folding-isearch) ;; This used to be a separate package.

(run-hooks 'folding-load-hook)

;;}}}

;;; folding.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/maplev.el0000775000000000000000000062160712230377266021071 0ustar  ;;; maplev.el --- Maple mode for GNU Emacs
;;
;;
;; Copyright (C) 2001,2003 Joseph S. Riel

;; Authors:    Joseph S. Riel 
;;             and Roland Winkler 
;; Time-stamp: "2003-10-09 22:49:16 joe"
;; Created:    June 1999
;; Version:    2.155
;; Keywords:   Maple, languages
;; X-URL:      http://www.k-online.com/~joer/maplev/maplev.html
;; X-RCS:      $Id: maplev.el,v 1.3 2009/11/12 21:33:35 psg Exp $

;;{{{ License

;; 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 2 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, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
;; 02111-1307, USA.

;;}}}
;;{{{ Introduction

;;; Commentary:
;;
;; This package defines five major modes:
;;
;;   maplev-mode:        for editing Maple code
;;   maplev-cmaple-mode: for running Maple
;;   maplev-mint-mode:   for displaying the output of mint
;;   maplev-help-mode:   for displaying Maple help pages
;;   maplev-proc-mode:   for displaying Maple procedures

;;; Features:

;; font-lock (highlighting) of Maple keywords
;; automatic indentation
;; syntax checking (via Mint)
;; online Maple help
;; online display of Maple procedures
;; outlining (not yet)
;; narrowing (nothing here)
;; tags
;; imenu support
;; auto-fill support

;;; Installation:

;; Put this file into your Emacs load path and byte compile it.  Add
;; the following to your `.emacs':
;;
;;   (autoload 'maplev-mode "maplev" "Maple editing mode" t)
;;   (autoload 'cmaple      "maplev" "Start maple process" t)
;;
;; To have Emacs automagically start in MapleV mode when editing Maple
;; source, add the following to your .emacs, modifying the regexp
;; `.mpl' to an extension appropriate for your usage:
;;
;;   (setq auto-mode-alist (cons `("\\.mpl\\'" . maplev-mode) auto-mode-alist))
;;
;; YOU MUST customize some of the default settings to be appropriate
;; for your installation.  You can do this in several ways.  The most
;; user friendly way is to use `customize'.  You can do this with:
;;
;;   M-x load-library RET maplev RET
;;   M-x customize-group RET maplev RET
;;
;; The important options are in the subgroup `maplev-important'.  After
;; setting and testing these options, save them to your .emacs by
;; clicking on the `Save for Future Sessions' button.
;;
;;
;;; History:

;; Oct 99:  Initial release.

;;}}}
;;{{{ To Do

;; High Priority:
;; - make `maplev-beginning-of-proc' and `maplev-end-of-proc' more reliable.
;;
;; Medium Priority:
;; - add comment-out functions
;; - pass `maplev-beginning-of-proc' (or faster) to `font-lock-defaults'.
;;   That should speed up fontification with lazy(?) lock.  Testing.
;; - add clean up routine to kill buffers and processes
;;   when exiting maplev-mode
;; - indent continued assignments (this could be tricky)
;; - more complete definition of maplev-completion-alist based on
;;   the maple help node `index[package]'
;;
;; Low Priority:
;; - font lock local variables
;; - fix problem with folding

;;}}}

;;; Code:

;;{{{ Information

(defconst maplev-version 
  "2.155"
  "Version of MapleV mode.")

(defconst maplev-developer 
  "Joseph S. Riel  and Roland Winkler "
  "Developers/maintainers of maplev-mode.")

(defun maplev-about ()
  (interactive)
  (sit-for 0)
  (message "maplev-mode version %s, (C) %s" maplev-version maplev-developer))

;;}}}

(require 'abbrevlist)
(require 'font-lock)
(require 'comint)
(require 'info)
(require 'cl)

(eval-and-compile
  (condition-case nil (require 'imenu) (error nil))
  (condition-case nil (require 'align) (error nil)))

(defsubst maplev--short-delay ()
  "Pause for a brief duration."
  (sleep-for 0.1))

;;{{{ Compatibility assignments

(eval-and-compile
  (if (not (boundp 'folding-mode)) (defvar folding-mode nil))
  (if (not (fboundp 'folding-open-buffer)) (defun folding-open-buffer ()))

  (defvar maplev-xemacsp
    (or (featurep 'xemacs)
        (string-match "XEmacs\\|Lucid" (emacs-version)))
    "*Non-nil when running under under Lucid Emacs or Xemacs.")

  (when (or (string< emacs-version "20.4") maplev-xemacsp)
    (defun line-beginning-position (&optional n)
      "Return the character position of the first character on the current line.
With argument N not nil or 1, move forward N - 1 lines first.
If scan reaches end of buffer, return that position.
This function does not move point."
      (save-excursion
        (beginning-of-line n)
        (point)))

    (defun line-end-position (&optional n)
      "Return the character position of the last character on the current line.
With argument N not nil or 1, move forward N - 1 lines first.
If scan reaches end of buffer, return that position.
This function does not move point."
      (save-excursion
        (end-of-line n)
        (point))))

  (if maplev-xemacsp
      (defun match-string-no-properties (num &optional string)
        "Return string of text matched by last search, without text properties.
NUM specifies which parenthesized expression in the last regexp.
 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
Zero means the entire text matched by the whole regexp or whole string.
STRING should be given if the last search was by `string-match' on STRING."
        (if (match-beginning num)
            (if string
                (let ((result
                       (substring string (match-beginning num) (match-end num))))
                  (set-text-properties 0 (length result) nil result)
                  result)
              (buffer-substring-no-properties (match-beginning num)
                                              (match-end num))))))

  ;; The following two inline functions are needed by GNU emacs.
  ;; They mimic the builtin Xemacs functions.
  (unless maplev-xemacsp
    (defun event-window (event)
      "Return the window over which mouse EVENT occurred."
      (nth 0 (nth 1 event)))
    (defun event-point (event)
      "Return the character position of the mouse EVENT."
      (posn-point (event-start event))))

  (defun maplev--mouse-keymap (keys)
    "Generate vector keymap for KEYS corresponding to a mouse button.
It handles the difference between Emacs and Xemacs.  KEYS is a list, the last item
is an integer correspond to the button number; preceding items are optional modifiers"
    (let ((rkeys (reverse keys)))
      (setcar rkeys (intern (concat (if maplev-xemacsp "button" "mouse-")
                                    (number-to-string (car rkeys)))))
      (vector (reverse rkeys)))))

;;}}}

;;{{{ Group definitions

(defgroup maplev nil
  "Major mode for editing Maple source in Emacs"
  :group 'languages)

(defgroup maplev-important nil
  "STUFF THAT MUST BE CONFIGURED."
  :group 'maplev)

(defgroup maplev-faces nil
  "Faces for highlighting text in MapleV mode."
  :group 'maplev)

(defgroup maplev-executables nil
  "Maple and Mint location and configuration."
  :group 'maplev)

(defgroup maplev-templates nil
  "Procedure template and other shortcuts."
  :group 'maplev)

(defgroup maplev-misc nil
  "Miscellaneous options."
  :group 'maplev)

(defgroup maplev-align nil
  "Alignment variables."
  :group 'maplev)

;;}}}
;;{{{ Configurable options

;;{{{   executables

(defcustom maplev-executable-alist
  (if (string-match "windows-nt\\|ms-dos" (symbol-name system-type))
      '(
        ("11" . ("c:/Program Files/Maple Release 11/bin.wnt/cmaple11.exe"
                nil
                "c:/Program Files/Maple Release 10/bin.wnt/mint10.exe"))
        ("10" . ("c:/Program Files/Maple Release 10/bin.wnt/cmaple10.exe"
                nil
                "c:/Program Files/Maple Release 10/bin.wnt/mint10.exe"))
        ("9" . ("c:/Program Files/Maple Release 9/bin.wnt/cmaple9.exe"
                nil
                "c:/Program Files/Maple Release 9/bin.wnt/mint9.exe"))
        ("8" . ("c:/Program Files/Maple Release 8/bin.wnt/cmaple.exe"
                nil
                "c:/Program Files/Maple Release 8/bin.wnt/mint.exe"))
        ("7" . ("c:/Program Files/Maple Release 7/bin.wnt/cmaple.exe"
                nil
                "c:/Program Files/Maple Release 7/bin.wnt/mint.exe"))
        ("6" . ("c:/Program Files/Maple Release 6/bin.wnt/cmaple.exe"
                nil
                "c:/Program Files/Maple Release 6/bin.wnt/mint.exe"))
        ("5.1" . ("c:/Program Files/MapleV Release 5.1/bin.wnt/cmaple.exe"
                  nil
                  "c:/Program Files/MapleV Release 5.1/bin.wnt/mint.exe"))
        ("5" . ("c:/Program Files/MapleV Release 5/bin.wnt/cmaple.exe"
                nil
                "c:/Program Files/MapleV Release 5/bin.wnt/mint.exe"))
        ("4"   . ("c:/maplev4/bin.win/cmaple.exe"
                  nil
                  "c:/maplev4/bin.win/mint.exe")))
    '(
      ("11"  . ("maple" nil "mint"))
      ("10"  . ("maple" nil "mint"))
      ("9"   . ("maple" nil "mint"))
      ("8"   . ("maple" nil "mint"))
      ("7"   . ("maple" nil "mint"))
      ("6"   . ("maple" nil "mint"))
      ("5.1" . ("maple" nil "mint"))
      ("5"   . ("maple" nil "mint"))
      ("4"   . ("maple" nil "mint"))))
  "*Assoc list specifying the available executables.
Each item has the form \(RELEASE MAPLE MAPLE-INIFILE MINT\)
where RELEASE is the Maple release corresponding to the
executables MAPLE and MINT.  MAPLE must be the command line
\(non-GUI\) version of Maple.  MAPLE-INIFILE is the maple
initialization file for running Maple under Emacs;
if nil the default initialization file is used."
  :type '(repeat (list (string :tag "Maple Release")
                       (file   :tag "Maple Executable")
                       (choice :tag "Maple Initialization File"
                               file (const :tag "none" nil))
                       (file   :tag "Mint Executable ")))
  :group 'maplev-executables
  :group 'maplev-important)

;; this isn't quite right, it doesn't permit assigning
;; a new release.

(defcustom maplev-default-release "11"
  "*Release of Maple used as the default executable.
It must be a key in `maplev-executable-alist'."
  :type `(choice ,@(mapcar (lambda (item)
                             (list 'const (car item)))
                           maplev-executable-alist))
  :group 'maplev-executables
  :group 'maplev-important)

(defvar maplev-release maplev-default-release
  "Buffer local string variable assigned the selected release of Maple.
Used to index `maplev-executable-alist'.")
(make-variable-buffer-local 'maplev-release)

(defcustom maplev-init-string-alist
  (let ((maplev-print-R5-
         (concat
          "if not assigned(maplev_print) then\n"
          "  maplev_print := proc(n)\n"
          "    print(`if`(type(evaln(n),'procedure'),eval,readlib)(n))\n"
          "  end;\n"
          "fi:\n"))
        (maplev-print-R6+
         (concat
          "if not assigned(maplev_print) then"
          "  maplev_print := print "
          "fi:\n"))
        (maplev-interface-string
         (concat
          "prettyprint=1,"
          "verboseproc=2,"
          "errorbreak=0,\n"
          "screenheight=infinity,"
          "warnlevel=2"))
        (maplev-kernelopts "kernelopts(printbytes=false):\n"))
    `(
      ("11"  . ,(concat maplev-print-R6+
                        "interface(" maplev-interface-string
                        ",errorcursor=false):\n"
                        maplev-kernelopts))
      ("10"  . ,(concat maplev-print-R6+
                        "interface(" maplev-interface-string
                        ",errorcursor=false):\n"
                        maplev-kernelopts))
      ("9.5" . ,(concat maplev-print-R6+
                        "interface(" maplev-interface-string
                        ",errorcursor=false):\n"
                        maplev-kernelopts))
      ("9" . ,(concat maplev-print-R6+
                      "interface(" maplev-interface-string
                      ",errorcursor=false):\n"
                      maplev-kernelopts))
      ("8" . ,(concat maplev-print-R6+
                      "interface(" maplev-interface-string
                      ",errorcursor=false):\n"
                      maplev-kernelopts))
      ("7" . ,(concat maplev-print-R6+
                      "interface(" maplev-interface-string
                      ",errorcursor=false):\n"
                      maplev-kernelopts))
      ("6" . ,(concat maplev-print-R6+
                      "interface(" maplev-interface-string
                      ",errorcursor=false):\n"
                      maplev-kernelopts))
      ("5.1" . ,(concat maplev-print-R5-
                        "interface(" maplev-interface-string
                        ",errorcursor=false):\n"
                        maplev-kernelopts))
      ("5" . ,(concat maplev-print-R5-
                      "interface(" maplev-interface-string
                      ",errorcursor=false):\n"
                      maplev-kernelopts))
      ("4" . ,(concat maplev-print-R5-
                      "interface(" maplev-interface-string "):\n"
                      maplev-kernelopts))
      ))
  "*Assoc list of Maple commands initializing a maple session.
Each item has the form \(RELEASE COMMANDS\) where RELEASE is the
Maple release.  COMMANDS must be a string of Maple commands."
  :type '(repeat (cons (string :tag "Maple Release")
                       (string :tag "Maple Commands")))
  :group 'maplev-executables
  :group 'maplev-important)

(defcustom maplev-mint-info-level 3
  "*Integer controlling amount of information that Mint outputs."
  :type '(choice (const :tag "no info" 0)
                 (const :tag "severe errors" 1)
                 (const :tag "+ serious errors" 2)
                 (const :tag "+ warnings" 3)
                 (const :tag "full report" 4))
  :group 'maplev-mint)

(defcustom maplev-mint-error-level 1
  "*Integer controlling Mint error checking in Maple input."
  :type '(choice (const :tag "no info" 0)
                 (const :tag "severe errors" 1)
                 (const :tag "+ serious errors" 2)
                 (const :tag "+ warnings" 3)
                 (const :tag "full report" 4))
  :group 'maplev-mint)

(defcustom maplev-mint-start-options (list "-q")
  "*List of mint command line options.  
Do not include the info level or the include path,
they are handled by `maplev-mint-info-level' and `maplev-include-path'."
  :type 'list
  ;;   :type '(repeat (choice (const :tag "no logo" " -q")
  ;;                       (const :tag "suppress startup" " -s")
  ;;                       (const :tag "syntax only" " -S")
  ;;                       (const :tag "cross reference" " -x")
  ;;                       (list :tag "library" (const " -b") directory)
  ;;                       (list :tag "append database" (const " -a ") file)
  ;;                       (list :tag "use database" (const " -d ") file)
  ;;                       (list :tag "toggle error" (const " -t ") (string :tag "error number"))))

  :group 'maplev-mint)

(defcustom maplev-include-path nil
  "*List of directories to search for files to include.
Each element is a string (directory name) or nil.
The directories are passed to maple and to mint 
via the \"-I\" option; they are searched for files
specified in Maple preprocessor $include directives."
  :type '(choice (const nil) (repeat string))
  :group 'maplev-executables
  :group 'maplev-mint)

;;}}}
;;{{{   comments

(defcustom maplev-comment-column 40
  "*Column for inline comments.
Use \\[indent-for-comment] to insert or align an inline comment."
  :type 'integer
  :group 'maplev-comments)

(defcustom maplev-comment-start "#"
  "*String to insert to start a Maple inline comment."
  :type 'string
  :group 'maplev-comments)

;; not used by GNU emacs 21
(defcustom maplev-block-comment-start "# "
  "*String to insert to start a Maple standalone comment."
  :type 'string
  :group 'maplev-comments)

(defcustom maplev-auto-fill-comment-flag t
  "*Non-nil means initially enable `auto-fill-mode' in a Maple buffer."
  :type 'boolean
  :group 'maplev-comments)

;;}}}
;;{{{   indentation

(defcustom maplev-indent-level 4
  "*Indentation of Maple statements with respect to containing block."
  :type 'integer
  :group 'maplev-indentation)

(defcustom maplev-indent-declaration 0
  "*Indentation of Maple declarations \(local, global, option, description\)."
  :type 'integer
  :group 'maplev-indentation)

(defcustom maplev-dont-indent-re "[#$]"
  "*Lines starting with this regular expression will not be auto-indented."
  :type '(choice string (const :tag "default" nil))
  :group 'maplev-indentation)
 
;;}}}
;;{{{   templates

(defcustom maplev-copyright-owner "John Q. Public"
  "*Copyright owner inserted in the copyright string by `maplev--template-proc-module'."
  :type 'string
  :group 'maplev-templates
  :group 'maplev-important)

(defcustom maplev-comment-end-flag t
  "*Non-nil means add a template's name as a comment following the end.
See `maplev--template-proc-module'."
  :type 'boolean
  :group 'maplev-templates)

;;; The reason for making this [the following] customizable is to
;;; support mapledoc, a LaTeX package.  To hide the name of the
;;; template in the the typeset output, I use the string " #% ".  To
;;; display it I might use " #\# ", which also prints the hash.

(defcustom maplev-template-end-comment " # "
  "*String prepended to the name of a template at the end,
following the \"end\".  See `maplev-comment-end-flag'."
  :type 'string
  :group 'maplev-templates)

(defcustom maplev-insert-copyright-flag t
  "*Non-nil means insert `maplev-copyright-owner' in a template.
See `maplev-template'."
  :type 'boolean
  :group 'maplev-templates)

(defcustom maplev-description-quote-char ?\`
  "*Quote character for the description statement.
Maple uses a backquote; however, in R5 it makes more sense to use a
double quote.  Procbody, alas, does not handle a double quote."
  :type 'character
  :group 'maplev-templates)

(defcustom maplev-variable-spacing 0
  "*Spaces to insert after a comma in declarations and argument lists."
  :type 'integer
  :group 'maplev-templates)

(defcustom maplev-assignment-operator " := "
  "*Maple assignment operator.  Used by `maplev-insert-assignment-operator'."
  :type 'string
  :group 'maplev-templates)

;;}}}
;;{{{   completion

(defcustom maplev-completion-longdelim-p nil
  "*If non-nil use the long delimiter when completing a Maple control structure.
For example, if non-nil, a `do' loop is completed with `end do',
otherwise it is completed with `od'.  If the maple release is less than 6
than the long delimiter is never used."
  :type 'boolean
  :group 'maplev-completions)

;;}}}
;;{{{   miscellaneous

;; Abbrev mode

(defcustom maplev-initial-abbrev-mode-flag nil
  "*Non-nil means initially enable function `abbrev-mode' in a Maple buffer."
  :type 'boolean
  :group 'maplev-misc)

(defcustom maplev-expand-abbrevs-in-comments-and-strings-flag nil
  "*Non-nil means expand Maple abbreviations in comments and strings.
Nil means do not expand in either."
  :type 'boolean
  :group 'maplev-misc
  :group 'maplev-comments)

;; Saving

(defcustom maplev-clean-buffer-before-saving-flag t
  "*Non-nil means run `maplev-remove-trailing-spaces' before saving."
  :type 'boolean
  :group 'maplev-misc)

;;}}}
;;{{{   align rules

;; Define the maplev alignment rules.
;; Align the assignment operator (`:='), equals signs,
;; columns (`|'), commas, double colons (`::'), and comments.  
;; Columns and commas are aligned only if the
;; the prefix argument is active (i.e. C-u M-x align).
;; The comment rule is the last rule so that comments are properly aligned.

(eval-and-compile
  (when (featurep 'align)
    (defcustom maplev-align-rules-list
      '((maple-assignment-rule
         (regexp   . "\\s-*\\w+\\(\\s-*:\\)=\\(\\s-*\\)")
         (group    . (1 2))
         (justify  . t)
         (tab-stop . nil))
        (maple-equals-rule
         (regexp   . "\\s-*\\w+\\(\\s-*\\)=\\(\\s-*\\)")
         (group    . (1 2))
         (repeat   . t)
         (tab-stop . nil))
        (maple-type-rule
         (regexp   . "\\s-*\\w+\\(\\s-*\\)::\\(\\s-*\\)")
         (group    . (1 2))
         (repeat   . t)
         (tab-stop . nil))
        (maple-column-delimiter
         (regexp . "\\(\\s-*\\)\|\\(\\s-*\\)")
         (group  . (1 2))
         (repeat . t)
         (run-if lambda nil current-prefix-arg))
        (maple-comma-delimiter
         (regexp . ",\\(\\s-*\\)\\S-")
         (repeat . t)
         (run-if lambda nil current-prefix-arg))
        (maple-comment
         (regexp . "\\(\\s-+\\)\\s<")
         (column . comment-column)))
      "*A list describing the maplev alignment rules.
See the documentation for `align-rules-list' for more info on the format."
      :type align-rules-list-type
      :group 'maplev-align)

    ;; Define the alignment exclusion rules.
    ;; The prevent changing quoted material and comments.

    (defcustom maplev-align-exclude-rules-list
      `((exc-dq-string
         (regexp . "\"\\([^\"\n]+\\)\"")
         (repeat . t))
        (exc-sq-string
         (regexp . "'\\([^'\n]+\\)'")
         (repeat . t))
        (exc-bq-string
         (regexp . "`\\([^`\n]+\\)`")
         (repeat . t))
        (exc-open-comment
         (regexp . ,(function
                     (lambda (end reverse)
                       (funcall (if reverse 're-search-backward
                                  're-search-forward)
                                (concat "[^ \t\n\\\\]"
                                        (regexp-quote comment-start)
                                        "\\(.+\\)$") end t))))))
      "*A list describing text that should be excluded from alignment.
See the documentation for `align-exclude-rules-list' for more info."
      :type align-rules-list-type
      :group 'maplev-align)))

;;}}}

;;}}}
;;{{{ Internal variables

(defvar maplev-mint--code-buffer nil
  "Buffer containing source code that was passed to Mint.")

(defvar maplev-mint--code-beginning nil
  "Marker at beginning of region in `maplev-mint--code-buffer' that was passed to Mint.")

(defvar maplev-mint--code-end nil
  "Marker at end of region in `maplev-mint--code-buffer' that was passed to Mint.")

(defvar maplev-completion-alist nil
  "Alist for minibuffer completion.
It has the form ((maple-release1  (...)) (maple-release2 (...)))")

(defvar maplev-completion-release nil
  "Maple release for which completion has been requested.")

(defvar maplev-history-list nil
  "History list used by maplev.")


;;}}}
;;{{{ Regular expressions

(defconst maplev--declaration-re
  "\\<\\(?:local\\|options?\\|global\\|description\\|export\\|uses\\)\\>"
  "Regular expression for a Maple procedure declaration statement.")

(defconst maplev--simple-name-re  "\\<[a-zA-Z_][a-zA-Z0-9_]*\\>"
  "Regular expression for a simple name.")

(defconst maplev--quoted-name-re  "`[^`\n\\\\]*\\(?:\\\\.[^`\n\\\\]*\\)*`"
  "Regular expression for a Maple quoted name.
It correctly handles escaped backquotes in a name, but not doubled
backquotes.  It intentionally fails for the exceptional case where a
name has a newline character.")

(defconst maplev--symbol-re (concat "\\(?:" 
                                    maplev--simple-name-re 
                                    "\\|"
                                    maplev--quoted-name-re
                                    "\\)")
  "Regular expression for a Maple symbol.")

(defconst maplev--name-re
  (concat maplev--symbol-re             ; base name
	  "\\(?:[ \t\n\f]*:-" maplev--symbol-re "\\)*" ; optional module components
          "\\(?:[ \t\n\f]*\\[[^][]*\\]\\)*" ; optional indices
          "\\(?:[ \t\n\f]*([^)(]*)\\)*") ; optional arguments
  "Regular expression for Maple names.")

(defconst maplev--comment-re "#.*$"
  "Regular expression for Maple comments.
A backslash at the end of the line does not continue the comment.")

(defconst maplev--defun-re "\\(?:\\\\|\\\\)"
  "Regular expression at start of a Maple procedure or module.")

(defconst maplev--assignment-re
  ;; Use "^" to anchor the regular expression.  This forces
  ;; re-search-backward to match the complete assignee name, provided
  ;; that the name is not a split between lines, a very poor practice.
;;  (concat "^\\s-*"
;;	  "\\(" maplev--name-re "\\)[ \t\n]*:=[ \t\n]*")
;;  "Regular expression that matches a Maple assignment.")
  (concat "\\(?:^\\|\\s-\\|[,]\\)"
	  "\\('?" maplev--name-re "'?\\)[ \t\n]*:?=[ \t\n]*")
  "Regular expression that matches a Maple assignment.")


(defconst maplev--defun-begin-re
  ;; This regular expression does not match a named module,
  ;; nor does it match a procedure/module that is not an
  ;; assignment statement.  
  (concat maplev--assignment-re
          "\\(?:" maplev--comment-re "\\)?"
          "[ \t\f\n]*" maplev--defun-re)
  "Regular expression for Maple defun assignments.  
The first group corresponds to the name of the defun.")

(defconst maplev--top-defun-begin-re
  (concat "^\\(" maplev--name-re "\\)[ \t\n]*:=[ \t\n]*"
          "\\(?:" maplev--comment-re "\\)?"
          "[ \t\f\n]*" maplev--defun-re)
  "Regular expression for top level Maple defun assignments.
The first group corresponds to the name of the defun.")


(defconst maplev--defun-end-re
  ;; This regular expression matches any nonqualified end statement,
  ;; such as "do ... end"; however, I consider such code to be bad form
  ;; (with the exception of procedures and modules, which allow it for
  ;; historical reasons).  The proper technique is "do ... end do" or
  ;; "do ... od".
  (concat "\\"
          "\\(?:[ \t]+" maplev--defun-re "\\)?"
          "[ \t]*[:;]")
  "Regular expression for \"end\" statement in a Maple defun.
It does not allow linebreaks as this messes up searching.  
It matches from the \"end\" to the terminating colon or semicolon.")

(defconst maplev--top-defun-end-re
  (concat "^\\(?:" maplev--defun-end-re "\\)" ; flush left end
          "\\|"                         ; or
          maplev--top-defun-begin-re "[^#\n]*" ; one line proc
          maplev--defun-end-re)
  "Regular expression for \"end\" statement in a top level Maple procedure assignment.
It matches either a flush left \"end\" or a one line procedure assignment.")

(defconst maplev--space-dot-quote-re "\\s-*\\.[`\"]") ; space could be allowed 'twixt dot and quote

;;;(defconst maplev--quote-re "\"[^\"]*\"\\|`[^`]*`")    ; fails when a quote contains a quote.

(defconst maplev--string-re "\"[^\"\\\\]*\\(\\\\[[:ascii:]][^\"\\\\]*\\)*\""
  "Regular expression that matches a double-quoted Maple string.
It matches even when a string contains newlines or escaped characters, 
including double-quotes.")


(defconst maplev--quote-re
  (concat maplev--quoted-name-re
          "\\|"
          maplev--string-re)
  "Regular expression that matches a backward-quoted name or double code string.")

(eval-and-compile
  (defun maplev--list-to-word-re (words)
    "Generate a regular expression that matches one of WORDS, a list."
    (concat "\\<\\(" (regexp-opt words) "\\)\\>")))

;;}}}
;;{{{ Syntax table

(defvar maplev-mode-syntax-table nil
  "Syntax table used in MapleV mode buffers \(except R4\).")

(unless maplev-mode-syntax-table
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?_  "_"  table) ; symbol constituent
    (modify-syntax-entry ?&  "w"  table) ; word constituent
    (modify-syntax-entry ?\\ "\\" table) ; escape
    (modify-syntax-entry ?#  "<"  table) ; comment starter
    (modify-syntax-entry ?\n ">"  table) ; newline = comment ender
    (modify-syntax-entry ?\f ">"  table) ; formfeed = comment ender
    (modify-syntax-entry ?\r " "  table) ; return = whitespace
    (modify-syntax-entry ?\t " "  table) ; tab = whitespace

    (modify-syntax-entry ?*  "."  table) ; punctuation
    (modify-syntax-entry ?/  "."  table)
    (modify-syntax-entry ?+  "."  table)
    (modify-syntax-entry ?-  "."  table)
    (modify-syntax-entry ?=  "."  table)
    (modify-syntax-entry ?<  "."  table)
    (modify-syntax-entry ?>  "."  table)
    (modify-syntax-entry ?.  "."  table)

    (modify-syntax-entry ?\' "\"" table) ; string quotes
    (modify-syntax-entry ?\` "\"" table) ; string quotes
    (modify-syntax-entry ?\{ "(}" table) ; balanced brackets
    (modify-syntax-entry ?\[ "(]" table)
    (modify-syntax-entry ?\( "()" table)
    (modify-syntax-entry ?\} "){" table)
    (modify-syntax-entry ?\] ")[" table)
    (modify-syntax-entry ?\) ")(" table)

    ;; Entries for R5 and later
    (modify-syntax-entry ?%  "."  table)
    (modify-syntax-entry ?\" "\"" table)

    (setq maplev-mode-syntax-table table)))

(defvar maplev-mode-4-syntax-table nil
  "Syntax table used in MapleV mode buffers for R4.")

;; In R4 the ditto operator is `"'

(unless maplev-mode-4-syntax-table
  (setq maplev-mode-4-syntax-table
        (copy-syntax-table maplev-mode-syntax-table))
  (modify-syntax-entry ?\" "." maplev-mode-4-syntax-table))

(defvar maplev--symbol-syntax-table nil
  "Syntax table for Maple, where `_' is a word consituent.")

(unless maplev--symbol-syntax-table
  (setq maplev--symbol-syntax-table (copy-syntax-table maplev-mode-syntax-table))
  (modify-syntax-entry ?_  "w"  maplev--symbol-syntax-table))

(defvar maplev-help-mode-syntax-table nil
  "Syntax table used in Maple help buffer.")

(unless maplev-help-mode-syntax-table
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?_ "w" table)
    (setq maplev-help-mode-syntax-table table)))

;;}}}

;;{{{ Indentation

;; The indentation functions handle the indentation of Maple code.
;; They are based on the Maple-mode package written by Nicholas
;; Thie'ry.  Considerable changes have been made to handle the
;; extended syntax introduced in Maple R6.  Following is a brief
;; description of the algorithm.
;; 
;; The buffer local list variable `maplev--update-indent-info' stores
;; the indentation information at a particular point, call it the
;; `known-indent-point' (the point position is stored in the list).
;; When a line is indented, the algorithm checks whether the current
;; position is greater than `known-indent-point'; if so, it only needs
;; to check between that point and the current position.  If not, it
;; needs to search backwards for a known valid indentation point.  The
;; function `maplev--validate-indent-info' handles this.
;;
;; The amount that a particular line is indented is determined by the
;; grammar defined by the constant assoc list `maplev--grammar-alist'. 
 


;;{{{   module

;; Define variables and functions for handling indentation information.

(defvar maplev--indent-info nil
  "Buffer local variable storing previous indent information.

Nil when there is no previous, or valid, indent information.
Otherwise it's a list: \(POINT STATE STACK\).  POINT is the character
position at which the information applies.  STATE is the output of
`parse-partial-sexp' \(valid from the start of the buffer to POINT\).
STACK is a list of lists, each list having the form \(KEYWORD
INDENT-CLOSE INDENT-FOLLOW\).  KEYWORD is a keyword or parenthesis in
the source.  INDENT-CLOSE is the indentation amount for the closing
keyword associated with KEYWORD.  INDENT-FOLLOW is the indentation
amount for source between KEYWORD and its closing keyword.")

;; Procedures for accessing the contents of `maplev--indent-info'.

(defsubst maplev--indent-info-point ()
  "Return position of last valid indent."
  (nth 0 maplev--indent-info))

(defsubst maplev--indent-info-state ()
  "Return output of `parse-partial-sexp' from last indent."
  (nth 1 maplev--indent-info))

(defsubst maplev--indent-info-stack ()
  "Return indentation stack."
  (nth 2 maplev--indent-info))

(defsubst maplev--indent-info-assign (point state stack)
  "Assign POINT, STATE, and STACK to the variable `maplev--indent-info'."
  (setq maplev--indent-info (list point state stack)))

(defsubst maplev-clear-indent-info ()
  "Clear the indent information."
  (interactive)
  (setq maplev--indent-info nil))


(defun maplev--validate-indent-info ()
  "Update the variable `maplev--indent-info' if nil.
Set POINT in variable to closest valid starting point.
Set STATE and STACK in variable to nil."
  (unless (and maplev--indent-info
               (>= (point) (maplev--indent-info-point)))
    ;; Set POINT to (point) if we're at the beginning of a top level
    ;; procedure assignment, otherwise search backwards for the
    ;; beginning or end of a top level procedure assignment and put
    ;; point outside it.  If neither is found, move point to the start
    ;; of the buffer.  WHAT ABOUT NARROWING AND/OR FOLDING?
    (maplev--indent-info-assign
     (or (and (looking-at maplev--top-defun-begin-re) (point))
         ;; Handle noweb mode.
         ;; If noweb is active in the buffer, then search for
         ;; the chunk starter.
         (and (boundp 'noweb-minor-mode) noweb-minor-mode
              (save-excursion
                (when (re-search-backward "^<<\\(.*\\)>>=$" nil t)
                  (1+ (match-end 0)))))
         (save-excursion
           (when (re-search-backward
                  (concat "\\(" maplev--top-defun-begin-re "\\)\\|"
                          "\\(" maplev--top-defun-end-re "\\)") nil t)
             (if (nth 2 (match-data))   ; found proc?
                 (match-beginning 0)    ;   start of proc
               (match-end 0))))         ;   end of proc
         (point-min))                   ; top of buffer
     nil nil)))

(defun maplev--before-change-function (beg &rest unused)
  "Clear indent info if the buffer change is before the last info location.
This function is called whenever the buffer is changed.  BEG is the
character position of the beginning of the change.  UNUSED is not used."
  (and maplev--indent-info
       (< beg (maplev--indent-info-point))
       (maplev-clear-indent-info)))

;;}}}
;;{{{   grammar

(defconst maplev--grammar-alist nil
  "Assoc list defining the grammar for Maple indentation.
Each entry has the form \(KEY . \(MATCH-RE OPEN-P INDENT ADJUST-FUNC
POST-FUNC\)\).  KEY is a Maple keyword or parenthesis.  MATCH-RE is a
regular expression that matches any of the keys that follow KEY; nil
means that KEY closes a Maple statement.  OPEN-P is a boolean flag
that is non-nil if KEY can initiate a Maple statement.  INDENT is the
relative indentation for the block immediately following KEY; nil
means that the indentation is handled in an ad hoc fashion.
ADJUST-FUNC is optional, if non-nil it is a function that moves point
to the position from where the indent is computed.  POST-FUNC is
optional, if non-nil it is a function that is called after the keyword
is handled.  Currently it is only used by the keyword `end'.")

;; Removed "in" from grammar to allow its use as a binary operator in Maple R8.
;; The change in the indentation is minor; rarely is there a line break between 
;; an "in" and the "do" in a loop.

(unless maplev--grammar-alist
  (let ((alist
         (list
          (list "proc" . ("\\" t maplev-indent-level 'maplev--indent-point-of-proc))
          (list "module" . ("\\" t maplev-indent-level 'maplev--indent-point-of-proc))
          (list "end"  . (nil nil 0 nil 'maplev--skip-optional-end-keyword))
;;;          (list "for"  . ((maplev--list-to-word-re '("from" "to" "by" "while" "in" "do")) t 0))
          (list "for"  . ((maplev--list-to-word-re '("from" "to" "by" "while" "do")) t 0))
          (list "for"  . ((maplev--list-to-word-re '("from" "to" "by" "while""do")) t 0))
          (list "from" . ((maplev--list-to-word-re '("to" "by" "while" "do")) t 0))
          (list "to"   . ((maplev--list-to-word-re '("by" "while" "do")) t 0))
          (list "by"   . ((maplev--list-to-word-re '("from" "to" "while" "do")) t 0))
          (list "while" . ((maplev--list-to-word-re '("from" "to" "by" "do")) t 0))
;;;          (list "in"   . ((maplev--list-to-word-re '("while" "do" "end")) t maplev-indent-level))
          (list "do"   . ((maplev--list-to-word-re '("od" "end")) t maplev-indent-level))
          (list "od"   . (nil nil 0))

          (list "if"   . ("\\" t 0))
          (list "elif" . ("\\" nil 0))
          (list "else" . ((maplev--list-to-word-re '("fi" "end")) nil maplev-indent-level))
          (list "then" . ((maplev--list-to-word-re '("elif" "else" "fi" "end")) nil maplev-indent-level))
          (list "fi"   . (nil nil 0))

;;;          (list "use"  . ("\\" t maplev-indent-level))
          (list "use"  . ("\\" t maplev-indent-level))
          (list "try"  . ((maplev--list-to-word-re '("catch" "finally" "end")) t maplev-indent-level))
          (list "catch". ((maplev--list-to-word-re '("catch" "finally" "end")) t maplev-indent-level))
          (list "finally". ((maplev--list-to-word-re '("end")) t maplev-indent-level))

          (list "{"    . ("}" t nil))
          (list "["    . ("]" t nil))
          (list "("    . (")" t nil))
          (list "}"    . (nil nil 0))
          (list "]"    . (nil nil 0))
          (list ")"    . (nil nil 0)))))
    (setq maplev--grammar-alist alist)))


(defconst maplev--grammar-keyword-re
  (eval-when-compile
    (concat
     ;;     (maplev--list-to-word-re
     (maplev--list-to-word-re
      '("proc" "module" "end"
;;;      "for" "from" "to" "by" "while" "in" "do" "od"
        "for" "from" "to" "by" "while" "do" "od"
        "if" "elif" "else" "then" "fi"
        "use" "try" "catch" "finally"))
     "\\|\\("
     (regexp-opt '("{" "}" "[" "]" "(" ")" ))
     "\\)"))
  "Regular expression of keywords used in Maple grammar for indentation.")

(defun maplev--skip-optional-end-keyword ()
  "Skip the optional keyword following an end statement."
  (if (looking-at (concat "[ \t]+"
                          (maplev--list-to-word-re '("proc" "module" "do" "use" "if" "try"))))
      (goto-char (match-end 0))))

;;}}}
;;{{{   errors

;; Create a new error symbol, `keyword-out-of-sequence', for handling
;; keywords and parentheses that appear out of sequence during an
;; indentation.  It isn't clear to me that this is the proper way to
;; handle this rather special condition; but I'll go with it for now.

(put 'keyword-out-of-sequence
     'error-conditions
     '(error keyword-out-of-sequence))

(put 'keyword-out-of-sequence 'error-message "Keyword out of sequence")

(defun maplev--handle-grammar-error (err)
  "Handle a grammar error ERR.
Push the mark \(so that we can return to it with \\[universal-argument] \\[set-mark-command]\),
ding the bell, display a message, and move point to the
start of the offending keyword."
  (push-mark)
  (ding)
  (message "Keyword `%s' out of sequence" (nth 1 err))
  (goto-char (nth 2 err)))

;;}}}
;;{{{   functions

(defun maplev-goto-previous-codeline ()
  "Move point to the start of the previous line of Maple code.
Blank lines and comment lines are skipped.
THIS WILL FAIL IN A STRING."
  (interactive)
  (while (and (= (forward-line -1) 0)
              (looking-at "\\s-*\\(#\\|$\\)"))))

(defun maplev--indent-point-of-proc ()
  "Move point to position from where a procedure is indented.
Point must originally be just to the left of the \"proc\" or \"module\".
If procedure is anonymous, point is not moved and nil is returned.
Otherwise point is moved to left of assignee and point is returned."
  ;; Regexp does not include possible comments.
  (and (re-search-backward (concat maplev--assignment-re "\\=") nil t)
       (goto-char (match-beginning 1))))

(defun maplev--indent-line-with-info ()
  "Indent the current line as Maple code.  Point must be at the left margin."
  (unless (or (and maplev-dont-indent-re
                   (looking-at maplev-dont-indent-re))
              (let ((state (maplev--indent-info-state)))
                (or (nth 3 state) (nth 4 state))))
    (delete-region (point) (progn (skip-chars-forward " \t") (point)))
    (indent-to (maplev--compute-indent (car (maplev--indent-info-stack))))))

;;}}}
;;{{{   algorithm

;; Algorithm:

;; The indentation algorithm is intended to provide rapid indentation
;; both for interactive use, that is, using `maplev-indent-newline',
;; and for global use, that is, using `maplev-indent-region'.
;;
;; To rapidly indent a region, previous indentation information is
;; stored in data structure, `maplev--indent-info'.  See its docstring
;; for a description of the structure.  To interactively indent, the
;; data is checked to see if there is usable information.  If so, it
;; is used, otherwise the nearest preceding syntactically
;; grammatically point (the start or end of a top level procedure
;; assignment) is found and the indentation information computed from
;; that point.


(defun maplev--update-indent-info ()
  "Update the variable `maplev--indent-info' at point.
Scan the source for keywords and parentheses from the previous valid
indent position to point.  Update the stack and state according to the
syntax table and the grammar, `maplev--grammar-alist'.  Restore point.
The calling function must ensure that the previous info point is not
beyond \(point\)."

;; This uses unwind-protect to restore the syntax table.
;; Why not use with-syntax-table instead?  One excuse for
;; not changing this is that with-syntax-table is more complicated,
;; it uses unwind-protect as well as save-current-buffer.
  (save-excursion
    (let ((point (maplev--indent-info-point))
          (stack (maplev--indent-info-stack))
          (state (maplev--indent-info-state))
          (end (point))
          (previous-syntax-table (syntax-table))

          keyword keyword-beginning key-list indent indent-close
          adjust-func post-func top-stack old-keyword match-re
          case-fold-search)

      (unwind-protect
          (save-restriction
            (widen)

            ;; Change the buffer syntax table to maplev--symbol-syntax-table 
            ;; so that the underscore is considered a word constituent.

            (set-syntax-table maplev--symbol-syntax-table)
            (goto-char point)
            (while (re-search-forward maplev--grammar-keyword-re end 'move)

              ;; Assign loop variables.  KEY-POINT is assigned the position
              ;; after the next keyword.  If no keyword exists in the line,
              ;; KEY-POINT is nil.
              
              (setq keyword (match-string-no-properties 0)
                    key-list (cdr (assoc keyword maplev--grammar-alist))
                    indent (nth 2 key-list)
                    adjust-func (nth 3 key-list)
                    post-func (nth 4 key-list)
                    top-stack (car stack)
                    indent-close (nth 1 top-stack)
                    old-keyword (car top-stack) ; Don't set to (old) KEYWORD, it might have been matched
                    match-re (and old-keyword
                                  (car (cdr (assoc old-keyword maplev--grammar-alist))))
                    keyword-beginning (match-beginning 0)
                    state (parse-partial-sexp point (point) nil nil state)
                    point (point))
              (cond
               
               ;; If KEYWORD is in a comment or a quote, do nothing.
               ((or (nth 4 state) (nth 3 state))) ; comments are more frequent, so check first
               
               ;; Does KEYWORD pair with the top one on STACK?
               ((and match-re (string-match match-re keyword))
                ;; Should more keywords follow KEYWORD?
                (if (nth 0 key-list)
                    ;; If so, replace the top of STACK with a new list.  The
                    ;; new list has the new KEYWORD, the INDENT-CLOSE from
                    ;; the old list, and
                    (setcar stack (list keyword
                                        indent-close
                                        (+ indent-close indent)))
                  ;; otherwise pop the top of STACK.
                  (and post-func (funcall post-func))
                  (setq stack (cdr stack))))

               ;; Is KEYWORD an opening keyword?  Push a new item onto
               ;; STACK.

               ((nth 1 key-list)
                (setq stack
                      (cons
                       (cons
                        keyword
                        ;; Handle keywords and parentheses appropriately.
                        ;; Indentation for keywords that
                        ;; start a Maple statement is from
                        ;; `keyword-beginning'; however, if the
                        ;; keyword is an assigned proc then the actual
                        ;; beginning of the keyword is the start of
                        ;; the assigned name.
                        (if indent
                            (save-excursion
                              (goto-char keyword-beginning)
                              (and adjust-func (funcall adjust-func))
                              (list (current-column) ; alignment for closing keyword
                                    (+ (current-column) indent))) ; alignment for subblock

                          ;; Handle an open parenthesis.  INDENT-CLOSE is
                          ;; set to the same column as the parerenthesis so
                          ;; that the closing parenthesis is aligned.  If
                          ;; space or a a comment follows the parenthesis,
                          ;; then the following block of code is indented
                          ;; from the current indentation.  Otherwise
                          ;; following code indents to first character
                          ;; following the parenthesis.
                          (list
                           (1- (current-column)) ; INDENT-CLOSE
                           (progn
                             (skip-chars-forward " \t")
                             (if (looking-at "#\\|$") ; no code on remainder of line
                                 (+ (current-indentation) maplev-indent-level)
                               (current-column))))))
                       stack)))

               ;; KEYWORD is out of sequence.  Move point before KEYWORD and
               ;; signal an error.
               (t (re-search-backward keyword)
                  (signal 'keyword-out-of-sequence (list keyword (point))))))
            (if (< point end)
                (setq state (parse-partial-sexp point (point) nil nil state)))
            (maplev--indent-info-assign end state stack))
        ;; Restore the syntax table
        (set-syntax-table previous-syntax-table)))))

;;}}}
;;{{{   commands

(defun maplev--compute-indent (indent-info)
  "Return the indentation required for a Maple code line.
INDENT-INFO is the indentation information applicable to this line;
it it is a list of three items: \(KEYWORD INDENT-CLOSE INDENT-FOLLOW\).
See `maplev--indent-info' for details.  If INDENT-INFO is nil then 0
is returned.  Point must be at current indentation."
  (if (not indent-info)
      0
    (save-excursion
      (let ((point (point))
            case-fold-search)
        (cond
         ;; Handle declarations in procedures (and modules)
         ((and (string-match maplev--defun-re (car indent-info))
               (looking-at maplev--declaration-re))
          (+  maplev-indent-declaration
              (nth 1 indent-info)))
         ;; Continued dotted quotes, e.g. ``."a string".''
         ;; They are aligned with previous quoted material.
         ;; There should be a flag to disable this.
         ((and
           (looking-at maplev--space-dot-quote-re)
           (not (bobp))
           (save-excursion
             (maplev-goto-previous-codeline)
             (setq point (point))
             (end-of-line)
             (setq point (re-search-backward maplev--quote-re point 'move))))
          (goto-char point)
          (max 0 (1- (current-column))))

         ;; We've handled the special cases.
         ;; Now to tackle regular statements.
         (t
          (or
           (let* ((old-keyword (car indent-info))
                  (match (and old-keyword (nth 1 (assoc old-keyword maplev--grammar-alist)))))
             (nth (if (and match (looking-at match))
                      1
                    2)
                  indent-info))
           0)))))))                     ; maplev--compute-indent

(defun maplev-indent-region (beg end)
  "Indent the region between POINT and MARK.
BEG and END may also be passed to the function."
  (interactive "r")
  (condition-case err
      (save-excursion
        (let ((before-change-functions nil)
              (after-change-functions nil))
          ;; Clear the indent stack.  Goto to the start of the region.
          ;; Set up a marker for the end of the region (it is used to
          ;; compute the percent completed).
          (goto-char beg)
          (beginning-of-line)
          (setq end (set-marker (make-marker) end))
          (maplev-clear-indent-info)   ; temporary
          (maplev--validate-indent-info)

          ;; THE FOLLOWING LINE IS EXPERIMENTAL BUT SEEMS NECESSARY
          (maplev--update-indent-info)
          ;; Indent each line in the region

          (while (and (<= (point) end) (not (eobp)))
            (maplev--indent-line-with-info)
            (forward-line)
            (maplev--update-indent-info)
            (message "Indenting...(%d%%)"
                     (min 100 (* 10 (/ (* 10 (- (point) beg)) (- end beg))))))

          (message "Indenting...done")
          (set-marker end nil)))

    (keyword-out-of-sequence
     (maplev--handle-grammar-error err)))) ; {end} maplev-indent-region


(defun maplev-indent-buffer ()
  "Indent the buffer."
  (interactive)
  (save-restriction
    (widen)
    (maplev-indent-region (point-min) (point-max))))

(defun maplev-indent-procedure ()
  "Indent the current procedure or module."
  (interactive)
  (apply 'maplev-indent-region (maplev-current-defun)))

(defun maplev-indent-line ()
  "Indent current line according to grammar.
If point was to the left of the initial indentation, it moves to the
final indentation; otherwise it remains in the same position relative
to the indentation."
  (interactive)
  ;; 25-Feb-2001: Added condition-case to move cursor to an out of sequence keyword.
  (condition-case err
      (let ((before-change-functions nil))
        (goto-char (max (save-excursion
                          (beginning-of-line)
                          (maplev--validate-indent-info)
                          (maplev--update-indent-info)
                          (maplev--indent-line-with-info)
                          (point))
                        (point))))
    (keyword-out-of-sequence
     (maplev--handle-grammar-error err))))

;; This is used by `indent-for-comment' to decide how much to indent a
;; comment in Maple code based on its context.

(defun maplev-comment-indentation ()
  "Return the column at which a comment should be started or moved to.
If the line starts with a flush left comment, return 0."
  (if (looking-at "^#")
      0                         ; Existing comment at bol stays there.
    comment-column))

;; Xmaple doesn't support selections
(defun maplev-insert-cut-buffer (&optional arg)
  "Inserts the value of the X server cut-buffer 0.
Text string is added to kill ring. Prefix arguments are interpreted as
with \\[yank]."
  (interactive "*P")
  (kill-new (x-get-cut-buffer 0))
  (setq this-command 'yank)
  (yank arg))

;; borrowed from mouse-yank-at-click
(defun maplev-mouse-yank-cut-buffer (click arg)
  "Inserts the value of the X server cut-buffer 0 at the position clicked on.
Also move point to one end of the text thus inserted (normally the end),
and set mark at the beginning.
Prefix arguments are interpreted as with \\[yank].
If `mouse-yank-at-point' is non-nil, insert at point
regardless of where you click."
  (interactive "e\nP")
  (kill-new (x-get-cut-buffer 0))
  ;; Give temporary modes such as isearch a chance to turn off.
  (run-hooks 'mouse-leave-buffer-hook)
  (or mouse-yank-at-point (mouse-set-point click))
  (setq this-command 'yank)
  (setq mouse-selection-click-count 0)
  (yank arg))

;;}}}

;;}}}

;;{{{ Mode map

(defvar maplev-mode-map nil
  "Keymap used in Maple mode.")

(unless maplev-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [(tab)]                      'maplev-electric-tab)
    (define-key map [(meta tab)]                 'maplev-complete-symbol)
    (define-key map [(control c) (meta tab)]     'maplev-add-exports-of-module-at-point)
    (define-key map [(backspace)]                'backward-delete-char-untabify)
    (define-key map [(control backspace)]        'maplev-untab)
    (define-key map [(control ?\;)]              'maplev-insert-assignment-operator)
    (define-key map [(control c) (control t) ?p] 'maplev-template-proc)
    (define-key map [(control c) (control t) ?m] 'maplev-template-module)
    (define-key map [(control c) (control t) ?u] 'maplev-template-use-statement)

    (define-key map [(control j)]                'maplev-indent-newline)
    (define-key map [(control return)]           'maplev-newline-and-comment)
    (define-key map [(meta control h)]           'maplev-mark-defun)
    ;;  (define-key map [(meta control a)]           'maplev-beginning-of-proc)
    ;;  (define-key map [(meta control e)]           'maplev-end-of-proc)
    (define-key map [(control x) ?n ?d]          'maplev-narrow-to-defun)

    ;; These two bindings are needed only under linux / unix
    (define-key map [(meta control y)]          'maplev-insert-cut-buffer)
    (define-key map (maplev--mouse-keymap '(control meta 2)) 'maplev-mouse-yank-cut-buffer)

    (define-key map [(control c) (control l)] 'maplev-add-local-variable)
    (define-key map [(control c) (control g)] 'maplev-add-global-variable)
    (define-key map [(control c) (control e)] 'maplev-add-export-variable)

    ;; Indent commands
    (define-key map [(control c) (tab) ?b]  'maplev-indent-buffer)
    (define-key map [(control c) (tab) tab] 'maplev-indent-buffer)
    (define-key map [(control c) (tab) ?p]  'maplev-indent-procedure)
    (define-key map [(control c) (tab) ?r]  'maplev-indent-region)
    (define-key map [(control c) (tab) ?k]  'maplev-clear-indent-info)
    

    ;; Cmaple commands
    (define-key map [(control c) (control c) ?b]      'maplev-cmaple-send-buffer)
    (define-key map [(control c) (control c) ?p]      'maplev-cmaple-send-procedure)
    (define-key map [(control c) (control c) ?r]      'maplev-cmaple-send-region)
    (define-key map [(control c) (control c) return]  'maplev-cmaple-send-line)
    (define-key map [(control c) (control c) ?g]      'maplev-cmaple-pop-to-buffer)
    (define-key map [(control c) (control c) ?i]      'maplev-cmaple-interrupt)
    (define-key map [(control c) (control c) ?k]      'maplev-cmaple-kill)
    (define-key map [(control c) (control c) ?s]      'maplev-cmaple-status)

    ;; Mint commands    

    (define-key map [(control c) (return) ?b] 'maplev-mint-buffer)
    (define-key map [(control c) (return) ?p] 'maplev-mint-procedure)
    (define-key map [(control c) (return) ?r] 'maplev-mint-region)
    (define-key map [(control c) (return) return] 'maplev-mint-rerun)

    ;; Help and proc comma    
      
    (define-key map [(control ?\?)] 'maplev-help-at-point)
    (define-key map [(meta ?\?)]    'maplev-proc-at-point)

    ;; Xemacs and FSF Emacs use different terms for mouse buttons

    (define-key map (maplev--mouse-keymap '(control shift 2)) 'maplev-help-follow-mouse)
    (define-key map (maplev--mouse-keymap '(meta shift 2))    'maplev-proc-follow-mouse)

    (define-key map [(control c) (control s) ?h] 'maplev-switch-buffer-help)
    (define-key map [(control c) (control s) ?l] 'maplev-switch-buffer-proc)
    (define-key map [(control c) (control s) ?c] 'maplev-switch-buffer-cmaple)

    (setq maplev-mode-map map)))

;;}}}
;;{{{ Menu

(defvar maplev--menu-decoration
  '(["reserved words"  (maplev-reset-font-lock 1) :style radio
     :selected (equal font-lock-maximum-decoration 1)]
    ["+ special words"  (maplev-reset-font-lock 2) :style radio
     :selected (equal font-lock-maximum-decoration 2)]
    ["+ builtin functions"  (maplev-reset-font-lock 3) :style radio
     :selected (or (equal font-lock-maximum-decoration 3)
                   (equal font-lock-maximum-decoration t))])
  "Menu items for changing the decoration level in Maple mode.")

(defvar maplev-menu nil)
(unless maplev-menu
  (easy-menu-define
    maplev-menu maplev-mode-map
    "Menu for MapleV mode."
    `("MapleV"
      ("Indent"
       ["Buffer"    maplev-indent-buffer t]
       ["Procedure" maplev-indent-procedure t]
       ["Region"    maplev-indent-region t])
      ("Mint"
       ["Buffer"    maplev-mint-buffer t]
       ["Procedure" maplev-mint-procedure t]
       ["Region"    maplev-mint-region t]
       ["Rerun"     maplev-mint-rerun :active maplev-mint--code-beginning]
       "---"
       ("Mint level"
        ["severe errors"  (setq maplev-mint-info-level   1) :style radio :selected (= maplev-mint-info-level 1)]
        ["+ serious errors" (setq maplev-mint-info-level 2) :style radio :selected (= maplev-mint-info-level 2)]
        ["+ warnings"       (setq maplev-mint-info-level 3) :style radio :selected (= maplev-mint-info-level 3)]
        ["full report"    (setq maplev-mint-info-level   4) :style radio :selected (= maplev-mint-info-level 4)]))
      ("Maple"
       ["Goto buffer"    maplev-cmaple-pop-to-buffer t]
       ["Send buffer"    maplev-cmaple-send-buffer t]
       ["Send procedure" maplev-cmaple-send-procedure t]
       ["Send region"    maplev-cmaple-send-region t]
       ["Send line"      maplev-cmaple-send-line t]
       "---"
       ["Interrupt"   maplev-cmaple-interrupt t]
       ["Kill"        maplev-cmaple-kill t])
      ("Help"
       ["Word"        maplev-help-at-point t]
       ["Highlighted" maplev-help-region t])
      "---"
      ("Setup"
       ("Maple Release"
        ,@(mapcar (lambda (item)
                    (let ((key (car item)))
                      `[,key (maplev-set-release ,key)
                             :style radio
                             :selected (string= maplev-release ,key)]))
                  maplev-executable-alist))
       ("Abbrevs"
        ["Enable abbrevs" abbrev-mode
         :style toggle :selected abbrev-mode]
        ["List abbrevs" maplev-abbrev-help t])
       ["Enable auto fill" auto-fill-mode
        :style toggle :selected auto-fill-function]
       ("Decoration" ,@maplev--menu-decoration))
      "---"
      ["Add Index" maplev-add-imenu (not (and (boundp 'imenu--index-alist)
                                              imenu--index-alist))]

      "---"
      ["Quit"      quit-window t]
      "---"
      ["Info"  maplev-goto-info-node t]
      ["About" maplev-about t])))

;;}}}
;;{{{ Abbreviations

(defun maplev--abbrev-hook ()
  "Unexpand an abbreviation in a string or a comment.
The variable `maplev-expand-abbrevs-in-comments-and-strings-flag'
controls the expansion."
  (unless maplev-expand-abbrevs-in-comments-and-strings-flag
    ;; Searching can be expensive:
    ;; We assume that strings do not span more than one line
    (let ((state (parse-partial-sexp (maplev-safe-position) (point))))
      (if (or (nth 4 state) (nth 3 state))
          (unexpand-abbrev)))))

(defvar maplev-mode-abbrev-table nil
  "Abbrev table used in MapleV mode buffers.")

(unless maplev-mode-abbrev-table
  (let ((ac abbrevs-changed))
    (define-abbrev-table
      'maplev-mode-abbrev-table
      '(("ar"    "array"      maplev--abbrev-hook 0)
        ("ass"   "assigned"   maplev--abbrev-hook 0)
        ("co"    "convert"    maplev--abbrev-hook 0)
        ("err"   "ERROR"      maplev--abbrev-hook 0)
        ("fail"  "FAIL"       maplev--abbrev-hook 0)
        ("fr"    "from"       maplev--abbrev-hook 0)
        ("gl"    "global"     maplev--abbrev-hook 0)
        ("inf"   "infinity"   maplev--abbrev-hook 0)
        ("lib"   "libname"    maplev--abbrev-hook 0)
        ("lo"    "local"      maplev--abbrev-hook 0)
        ("ma"    "matrix"     maplev--abbrev-hook 0)
        ("npf"   "nprintf"    maplev--abbrev-hook 0)
        ("null"  "NULL"       maplev--abbrev-hook 0)
        ("pi"    "Pi"         maplev--abbrev-hook 0)
        ("pnam"  "procname"   maplev--abbrev-hook 0)
        ("pf"    "printf"     maplev--abbrev-hook 0)
        ("remem" "remember"   maplev--abbrev-hook 0)
        ("ret"   "RETURN"     maplev--abbrev-hook 0)
        ("rlib"  "readlib"    maplev--abbrev-hook 0)
        ("stext" "searchtext" maplev--abbrev-hook 0)
        ("stxt"  "SearchText" maplev--abbrev-hook 0)
        ("ta"    "table"      maplev--abbrev-hook 0)
        ("th"    "then"       maplev--abbrev-hook 0)
        ("trap"  "traperror"  maplev--abbrev-hook 0)
        ("ty"    "type"       maplev--abbrev-hook 0)
        ("user"  "userinfo"   maplev--abbrev-hook 0)
        ("wh"    "while"      maplev--abbrev-hook 0)))
    (setq abbrevs-changed ac)))

(defun maplev-abbrev-help ()
  "List the currently defined abbreviations."
  (interactive)
  (list-one-abbrev-table maplev-mode-abbrev-table "*Abbrevs*"))

;;}}}
;;{{{ Imenu support
;; Index all the procedure assignments.  Other possiblities to index
;; are global variable assignments, macros and aliases; however,
;; selecting them is difficult.

(defvar maplev-imenu-generic-expression
  `(("Procedures" ,maplev--defun-begin-re 1)
    ("Variables" ,(concat "^\\(" maplev--name-re "\\)"
                          "[ \t\n]*:=[ \t\n]*"
                          "\\([^ \t\np]\\|p\\([^r]\\|r\\([^o]\\|o\\([^c]\\|c[^ \t\n(]\\)\\)\\)\\)") 1)
    ("Macros" ,(concat "^macro([ \t]*\\([^ \t=]*\\)") 1))
  "Imenu expression for MapleV mode.  See `imenu-generic-expression'.")

(defun maplev--imenu-goto-function (name position &rest ignore)
  "Move point to POSITION.  Ignore NAME and IGNORE.
This works with `folding-mode', but crudely.  Folding mode appears to
have an error; `folding-goto-char' does not work reliably.  Until that
is fixed the solution is to open the entire buffer."
  (and (or (< position (point-min))
           (> position (point-max)))
       (widen))
  (if folding-mode (folding-open-buffer))
  (goto-char position))

(defun maplev-add-imenu ()
  "Add an imenu of Maple procedures."
  (interactive)
  (imenu-add-to-menubar "Index")
  (menu-bar-mode 1))

(defun maplev--imenu-create-index-function ()
  "Create an index for `imenu'.
Check whether `folding-mode' is active."
  (if folding-mode (folding-open-buffer))
  (imenu-default-create-index-function))
;;}}}
;;{{{ Buffer edit functions

;; Does this work with folding-mode?
(defun maplev-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 maplev-goto-comment ()
  "Move point just after comment character in line.
If there is no comment character in the line, move point to end of line
and return nil, otherwise return t."
  (interactive)
  (beginning-of-line)
  (maplev--validate-indent-info)
  (let ((state  (parse-partial-sexp
                 (maplev--indent-info-point)
                 (point)
                 nil nil (maplev--indent-info-state))))
    (nth 4 (parse-partial-sexp
            (point)
            (line-end-position)
            nil nil state 'comment-stop))))

(defun maplev-fill-paragraph (&optional justify)
  "Like \\[fill-paragraph], but handles Maple comments.
Assigned to `fill-paragraph-function'.  If any of the current line is
a comment, fill the comment or the paragraph of it that point is in,
preserving the comment's indentation and initial comment symbol.
Prefix JUSTIFY means justify as well."
  (interactive "*P")
  (let (has-code      ; Non-nil if line contains code (possibly blank)
        comment-fill-prefix)  ; Appropriate fill-prefix for a comment.

    ;; Figure out what kind of comment we are looking at.

    (save-excursion
      (beginning-of-line)
      (setq has-code (looking-at "[ \t]*[^ \t#]"))
      (when (maplev-goto-comment)
        (backward-char)
        (looking-at "#+[\t ]*")
        (setq comment-fill-prefix
              (concat (if indent-tabs-mode
                          (progn
                            (make-string (/ (current-column) tab-width) ?\t)
                            (make-string (% (current-column) tab-width) ?\ ))
                        (make-string (current-column) ?\ ))
                      (buffer-substring (match-beginning 0) (match-end 0))))
        (save-restriction
          (beginning-of-line)
          (narrow-to-region
           ;; Find the first line we should include in the region to fill.
           (save-excursion
             (while (and (zerop (forward-line -1))
                         (looking-at "^[ \t]*#")))
             ;; We may have gone too far.  Go forward again if there
             ;; is no comment on this line.
             (or (looking-at ".*#")
                 (forward-line 1))
             (point))
           ;; Find the beginning of the first line past the region to fill.
           (save-excursion
             (while (progn (forward-line 1)
                           (looking-at "^[ \t]*#")))
             (point)))

          ;; Lines with only comment characters on them
          ;; can be paragraph boundaries.
          (let* ((paragraph-start    (concat paragraph-start "\\|[ \t#]*$"))
                 (paragraph-separate (concat paragraph-start "\\|[ \t#]*$"))
                 (paragraph-ignore-fill-prefix nil)
                 (fill-prefix comment-fill-prefix)
                 (after-line (if has-code
                                 (save-excursion
                                   (forward-line 1) (point))))
                 (end (progn
                        (forward-paragraph)
                        (or (bolp) (newline 1))
                        (point)))
                 ;; If this comment starts on a line with code,
                 ;; include that line in the filling.

                 (beg (progn (backward-paragraph)
                             (if (eq (point) after-line)
                                 (forward-line -1))
                             (point))))
            (fill-region-as-paragraph beg end
                                      justify nil
                                      (save-excursion
                                        (goto-char beg)
                                        (if (looking-at fill-prefix)
                                            nil
                                          (re-search-forward comment-start-skip)
                                          (point)))))))
      t)))

;;}}}
;;{{{ Info

;; This must go elsewhere (in maplev-mode).
;; (put 'maplev 'info-file "maplev")

;;(info 'maplev)

(defun maplev-goto-info-node ()
  "Go to the info node for maplev."
  (interactive)
  (require 'info)
  (let ((where (save-window-excursion
		 (Info-find-emacs-command-nodes 'maplev))))
    (if (not where)
        (error "Could not find info file for maplev")
      (let (same-window-buffer-names)
	(info))
      (Info-find-node (car (car where)) (car (cdr (car where)))))))
;;}}}

;;{{{ MapleV mode

;;{{{   Release

(defsubst maplev--major-release ()
  "Integer variable assigned the selected release of Maple."
  (truncate (string-to-number maplev-release)))

(defun maplev-set-release (&optional release)
  "Assign the buffer local variable `maplev-release'.
RELEASE is a key in `maplev-executable-alist', if not supplied then
`maplev-default-release' is used. Set syntax table according to
RELEASE. If in `maplev-mode' also refontify the buffer."
  (interactive
   (list (completing-read "Use Maple release: "
                          (mapcar (lambda (item) (list (car item)))
                                  maplev-executable-alist)
                          nil t)))
  (setq release (or release maplev-default-release))
  ;; Invalid values of release are possible only due to an invalid value
  ;; of maplev-default-release.
  (unless (assoc release maplev-executable-alist)
    (error "Invalid Maple release: %S" release))
  (setq maplev-release release)
  (cond ((memq major-mode '(maplev-mode maplev-cmaple-mode maplev-proc-mode))
         (if (< (maplev--major-release) 5)
             (set-syntax-table maplev-mode-4-syntax-table)
           (set-syntax-table maplev-mode-syntax-table)))
        ;; for consistency also maplev-help-mode
        ((eq major-mode 'maplev-help-mode)
         (set-syntax-table maplev-help-mode-syntax-table)))
  (when (eq major-mode 'maplev-mode)
    (maplev-reset-font-lock)
    (maplev-mode-name)))

;;}}}
;;{{{   definition

(defun maplev-mode ()
  "Major mode for editing Maple code.

\\[maplev-electric-tab] indents the current line.
\\[maplev-indent-newline] indents the current line and inserts a new indented line.
\\[maplev-newline-and-comment] inserts a newline and begins a flush left comment.

\\[maplev-insert-assignment-operator] inserts `:=' with spaces at end of line.
\\[maplev-template-proc] inserts a procedure template after querying for options.
\\[maplev-template-module] inserts a module template after querying for options.
\\[maplev-template-use-statement] inserts a use statement after querying for the expression sequence.

There are functions and keys for indenting code, syntax checking \(via mint\),
displaying Maple help pages and printing the source code of procedures from the
Maple libraries.

\\{maplev-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map maplev-mode-map)
  (setq major-mode 'maplev-mode)

  ;; abbreviation
  (setq local-abbrev-table maplev-mode-abbrev-table)

  ;; paragraph filling
  ;;
  ;; The assignment to `paragraph-start' is copied from emacs-lisp.el.
  ;; Note that because `page-delimiter' is, by default, "^\f", that
  ;; is, `^L' anchored to the beginning of the line, the assignment to
  ;; `paragraph-start' violates the explicit warning in the docstring
  ;; about not anchoring this value.  Not a big deal.

  (set (make-local-variable 'paragraph-start)         (concat page-delimiter "\\|$"))
  (set (make-local-variable 'paragraph-separate)       paragraph-start)
  (set (make-local-variable 'fill-paragraph-function) 'maplev-fill-paragraph)
  (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
  (set (make-local-variable 'adaptive-fill-mode)       nil)
  (set (make-local-variable 'auto-fill-inhibit-regexp) (concat "[ \t]*[^  \t#]"))

  (set (make-local-variable 'beginning-of-defun-function) #'maplev-beginning-of-defun)
  (set (make-local-variable 'end-of-defun-function)       #'maplev-end-of-defun)

  (set (make-local-variable 'require-final-newline) t)

  (auto-fill-mode (if maplev-auto-fill-comment-flag 1 0))

  ;; indentation
  (set (make-local-variable 'indent-line-function)   'maplev-indent-line)
  (set (make-local-variable 'indent-region-function) 'maplev-indent-region)
  (set (make-local-variable 'tab-width)               maplev-indent-level)
  (set (make-local-variable 'indent-tabs-mode)        nil)

  ;; abbrev expansion
  (abbrev-mode (if maplev-initial-abbrev-mode-flag 1 0))

  ;; comments
  (set (make-local-variable 'comment-start)            maplev-comment-start)
  (set (make-local-variable 'block-comment-start)      maplev-block-comment-start)
  (set (make-local-variable 'comment-end)              "")
  (set (make-local-variable 'comment-start-skip)       "#+[ \t]*")
  (set (make-local-variable 'comment-column)           maplev-comment-column)
  (set (make-local-variable 'comment-indent-function) 'maplev-comment-indentation)

  ;; menubar (for Xemacs, GNU Emacs doesn't need this)
  (and maplev-menu (easy-menu-add maplev-menu))

  ;; imenu
  (set (make-local-variable 'imenu-default-create-index-function)
       'maplev--imenu-create-index-function)
  (set (make-local-variable 'imenu-default-goto-function)
       'maplev--imenu-goto-function)
  (set (make-local-variable 'imenu-generic-expression)
       maplev-imenu-generic-expression)
  (set (make-local-variable 'imenu-case-fold-search) nil)

  ;; aligning rules

  (when (featurep 'align)
    (setq align-mode-rules-list maplev-align-rules-list)
    (setq align-mode-exclude-rules-list maplev-align-exclude-rules-list))

  ;; Font lock support: make these variables buffer-local
  ;; so that we can change the decoration level
  (make-local-variable 'font-lock-defaults)
  (make-local-variable 'font-lock-maximum-decoration)

  ;; Mint support
  (make-local-variable 'maplev-mint--code-beginning)
  (make-local-variable 'maplev-mint--code-end)

  ;; Is this what one wants??
  ;; (set (make-local-variable 'beginning-of-defun-function) #'(lambda () (maplev-proc-beginning 1 t)))
  ;; (set (make-local-variable 'end-of-defun-function)       #'(lambda () (maplev-proc-end 1 t)))
  ;; (set (make-local-variable 'add-log-current-defun-function)
  ;;      #'maplev-current-defun-name) ;; not yet available

  ;; Release support
  (maplev-set-release)
  ;; the file's local variables specs might change maplev-release
  ;; xemacs version of make-local-hook returns t, not the hook. (JR)
  ;; make-local-hook is obsolete in GNU emacs 21.1
  (make-local-hook 'hack-local-variables-hook)
  (add-hook 'hack-local-variables-hook 'maplev-mode-name nil t)

  ;; Set hooks
  (if maplev-clean-buffer-before-saving-flag
      (add-hook 'local-write-file-hooks 'maplev-remove-trailing-spaces))
  (make-local-hook 'before-change-functions)
  (add-hook 'before-change-functions 'maplev--before-change-function nil t)
  (run-hooks 'maplev-mode-hook))

(defun maplev-mode-name ()
  "Set `mode-name' in `maplev-mode' according to `maplev-release'."
  (setq mode-name (concat "Maple R" maplev-release)))

;;}}}

;;}}}

;;{{{ Electric functions

(defun maplev-indent-newline ()
  "Indent current line, insert a newline and indent the new line.
Current line is not indented if it is a comment.  Remove trailing
whitespace."
  (interactive "*")
  (or (maplev--comment-line-indentation) ; nil if a comment
      (maplev-indent-line))
  (delete-horizontal-space)             ; remove trailing whitespace
  (newline)
  (maplev-indent-line))

(defun maplev-insert-assignment-operator ()
  "Insert the Maple assignment operator after last nonwhite character."
  (interactive "*")
  (end-of-line)
  (skip-chars-backward " \t")
  (delete-region (point) (line-end-position))
  (insert maplev-assignment-operator))

(defun maplev-electric-tab ()
  "Indent the current line."
  (interactive "*")
  (maplev-indent-line))

(defun maplev-newline-and-comment ()
  "Insert a newline and start a new comment line.
If the current line is a code line, the comment is set flush left,
otherwise it is aligned with the previous code line."
  (interactive "*")
  (newline)                             ; should we indent?
  (let ((indent (maplev--comment-line-indentation -1)))
    (and indent (indent-to indent)))
  (insert block-comment-start))


(defun maplev--comment-line-indentation (&optional n)
  "Return the indentation of a Maple comment line, nil if not a comment line.
Optionally move N lines forward before testing.  Point is not affected."
  (save-excursion
    (forward-line (or n 0))
    (and (looking-at "^[ \t]*#") (current-indentation))))

(defun maplev-untab ()
  "Delete backwards to previous tab stop."
  (interactive "*")
  (backward-delete-char-untabify
   (let ((ind (% (current-column) maplev-indent-level)))
     (and (= ind 0) (setq ind maplev-indent-level))
     (if (> ind (current-column))
         (current-column)
       ind))))

;;}}}
;;{{{ Interactive functions

(defun maplev--beginning-of-defun-pos (&optional top n)
  "Return character position of beginning of previous defun.  If
optional argument TOP is non-nil, search for top level defun.  With
optional argument N, do it that many times.  Negative argument -N
means search forward to Nth preceding end of defun.  Return nil if
search fails."
  (let ((regexp (if top maplev--top-defun-begin-re maplev--defun-begin-re))
        pos)
    (setq n (or n 1))
    (save-excursion
      (cond ((> n 0)
             (and (setq pos 
                        ;; Assign pos the position of the previous beginning statement.
                        ;; Because point could be in the middle of the statement,
                        ;; first search backwards, then forwards.  If the beginning position
                        ;; of the forwards search is before the original point (orig),
                        ;; then use it, otherwise use the beginning position of the backwards search.
                        (let* ((orig (point))
                               (beg (maplev--re-search-backward regexp nil 'move)))
                          (if beg (goto-char (match-end 0)))
                          (or (and (maplev--re-search-forward regexp nil t)
                                   (< (setq pos (match-beginning 0)) orig)
                                   pos)
                              beg)))
                  ;; If n=1 then pos is the character position,
                  (if (= n 1)
                      pos
                    ;; otherwise, search backwards n-1 times.  
                    ;; Because we are starting at the end of a defun,
                    ;; we don't have to do the backwards search.
                    (goto-char pos)
                    (maplev--re-search-backward regexp nil t (1- n)))))
            ((< n 0)
             (and (maplev--re-search-backward regexp nil t n)
                  (match-beginning 0)))
            ((point))))))

(defun maplev--end-of-defun-pos (&optional top n)
  "Return character position of next end of defun.  If optional
argument TOP is non-nil, search for top level defun.  With optional
argument N, do it that many times.  Negative argument -N means search
back to Nth preceding end of defun.  Return nil if search fails."

  ;; The search algorithm is asymmetric with respect to direction.
  ;; Searching backwards (-N) for an end of defun is easy, just search
  ;; and move to the end of the match.  Searching forward is more
  ;; complicated because point could lie within an end statement.

  (let ((regexp (if top maplev--top-defun-end-re maplev--defun-end-re))
        pos)
    (setq n (or n 1))
    (save-excursion
      (cond ((> n 0)
             (and (setq pos 
                        ;; Assign pos the position of the next end statement.
                        ;; Because point could be in the middle of the statement,
                        ;; first search forward, then backwards.  If the end position
                        ;; of the backwards search is past the original point (orig),
                        ;; then use it, otherwise use the end position of the forward search.
                        (let* ((orig (point))
                               (end (maplev--re-search-forward regexp nil 'move)))
                          (if end (goto-char (match-beginning 0)))
                          (or (and (maplev--re-search-backward regexp nil t)
                                   (> (setq pos (match-end 0)) orig)
                                   pos)
                              end)))
                  ;; If n=1 then pos is the character position,
                  (if (= n 1)
                      pos
                    ;; otherwise, search forward n-1 times.  
                    ;; Because we are starting at the end of a defun,
                    ;; we don't have to do the backwards search.
                    (goto-char pos)
                    (maplev--re-search-forward regexp nil t (1- n)))))
            ((< n 0)
             (and (maplev--re-search-forward regexp nil t n)
                  (match-end 0)))
            ((point))))))

(defun maplev-beginning-of-defun (&optional n)
  "Move point backward to the beginning of defun.  With optional
argument N, move to the beginning of the Nth preceding defun.
Negative argument -N means move forward to the end of the Nth
following defun."
  (interactive)
  (setq n (or n 1))
  (goto-char (or (maplev--beginning-of-defun-pos nil n)
                 (if (> n 0) (point-min) (point-max)))))
       
(defun maplev-end-of-defun (&optional n)
  "Move point forward to the end of defun.  With optional argument N,
move to the end of the Nth following defun.  Negative argument -N
means move backwards to the end of the Nth preceding defun."
  (interactive)
  (setq n (or n 1))
  (goto-char (or (maplev--end-of-defun-pos nil n)
                 (if (> n 0) (point-max) (point-min)))))

(defun maplev-mark-defun ()
  "Put mark at end of this defun, point at beginning.
The defun marked is the one that contains point."
  (interactive)
  (push-mark (point))
  (beginning-of-line)
  (if (looking-at maplev--defun-begin-re) (goto-char (match-end 0)))
  (let ((count 1)
        (regexp (concat "\\(" maplev--defun-begin-re "\\)\\|\\(?:" maplev--defun-end-re "\\)")))
    (while (and (/= count 0)
                (re-search-forward regexp nil 'move))
      (setq count (+ count (if (match-beginning 1) 1 -1))))
    (forward-line)
    (push-mark (point) nil t)
    (when (= count 0)
      (goto-char (match-beginning 0))
      (setq count -1))
    (while (and (/= count 0)
                (re-search-backward regexp nil 'move))
      (setq count (+ count (if (match-beginning 1) 1 -1))))))

(defun maplev-current-defun ()
  "Return a list with buffer positions of begin and end of current defun."
  (save-excursion
    (maplev-mark-defun)
    (list (point) (mark))))

(defun maplev-narrow-to-defun ()
  "Make text outside current defun invisible."
  (interactive)
  (widen)
  (let ((reg (maplev-current-defun)))
    (narrow-to-region (car reg) (nth 1 reg))))

;;; stuff used by mint

(defun maplev--re-search-forward (regexp &optional bound noerror count)
  "Search forward from point for regular expression REGEXP.
This function is like re-search-forward, but comments are ignored.
Optional arguments BOUND, NOERROR, and COUNT have the same meaning
as in `re-search-forward'."
  ;; This approach gets confused by a comment inside the match
  ;; (e.g., when REGEXP can match more than one line).
  ;; Therefore it's better to break complex REGEXP's apart
  ;; and handle the items seperately.
  (if (not count) (setq count 1))
  (let ((dir (if (< count 0) -1 1))
        (pos (point))
        case-fold-search)
    (while (and (not (zerop count)) pos)
      (setq pos (re-search-forward regexp bound noerror dir))
      (while (and (nth 4 (parse-partial-sexp (maplev-safe-position) (point)))
                  (setq pos (re-search-forward regexp bound noerror dir))))
      (setq count (- count dir)))
    pos))
      
(defun maplev--re-search-backward (regexp &optional bound noerror count)
  "Search backward from point for regular expression REGEXP.
This function is like re-search-backward, but comments are ignored.
Optional arguments BOUND, NOERROR, and COUNT have the same meaning
as in `re-search-backward'."
  ;; See maplev--re-search-forward.
  (if (not count) (setq count 1))
  (let ((dir (if (< count 0) -1 1))
        (pos (point))
        case-fold-search)
    (while (and (not (zerop count)) pos)
      (setq pos (re-search-backward regexp bound noerror dir))
      (while (and (nth 4 (parse-partial-sexp (maplev-safe-position) (point)))
                  (setq pos (re-search-backward regexp bound noerror dir))))
      (setq count (- count dir)))
    pos))

(defun maplev-safe-position (&optional to)
  "Search for safe buffer position before point \(a position not in a comment\).
Optional arg TO initializes the search. It defaults to point"
  (unless to (setq to (point)))
  (save-excursion
    (save-match-data
      (goto-char to)
      (while (and (= 0 (forward-line -1))
                  (looking-at "#")))
      (point))))

(defun maplev--scan-lists (count &optional from)
  "Scan COUNT lists. Optional arg FROM defaults to position of point.
Returns the character number of the position thus found."
  (if (not from) (setq from (point)))
  (let ((parse-sexp-ignore-comments t))
    (scan-lists from count 0)))

(defun maplev-delete-whitespace (&optional back)
  "Delete whitespace characters plus empty comments at point.
If optional arg BACK is non-nil, delete whitespace characters before point."
  ;; It would be nice to have a function looking-at-backward,
  ;; but there is nothing like that. (Guess why :-)
  (if back (let ((pos (point)))
             (skip-chars-backward " \t\n")
             (delete-region pos (point)))
    (save-match-data
      ;; Is this regexp too aggressive?
      (if (looking-at "\\([ \t\n]\\|\\(#[ \t]*$\\)\\)*")
          (delete-region (match-beginning 0) (match-end 0))))))

(defun maplev--statement-terminator ()
  "Buffer position immediately following next non-comment semicolon or
colon that is not part of a double colon."
  (save-excursion
    (maplev--re-search-forward "[^:]\\(;\\|:[^:]\\)" nil t)
    (+ 1 (match-beginning 1))))

(defun maplev--goto-declaration (keyword)
  "Move point to the start of the KEYWORD declaration in a Maple procedure.
Return nil if there no such statement.  Point must be to the right of
the closing parenthesis in the formal parameter list."
  (let ((bound (save-excursion
                 (maplev--re-search-forward maplev--defun-re
                                            ;; (maplev-end-of-proc) 'move)
                                            (maplev--end-of-defun-pos) 'move)
                 (point))))
    (if (save-excursion
          (maplev--re-search-forward
           (concat "\\<" keyword "\\>") bound t))
        (goto-char (match-beginning 0)))))

(defun maplev-add-declaration (keyword var)
  "To the current procedure's KEYWORD declaration add VAR.
If necessary, add a KEYWORD statement.  Point must be after the closing
parenthesis of the procedure's argument list."
  (save-excursion
    (if (maplev--goto-declaration keyword)
        (progn
          (goto-char (maplev--statement-terminator))
          (backward-char)
          (insert "," (make-string maplev-variable-spacing ?\ ) var))
      (let (stay)
        ;; Declarations are ordered: local, global, export
        (if (maplev--goto-declaration "local")
            (setq stay (goto-char (maplev--statement-terminator))))
        (if (maplev--goto-declaration "global")
            (setq stay (goto-char (maplev--statement-terminator))))
        ;; Position point and text in preparation for inserting a
        ;; declaration statement.
        (if (not (looking-at "[ \t]*\\(#.*\\)?$")) ; More code on line?
            (just-one-space)      ; Then insert declaration inbetween.
          (forward-line)            ; Else move to the next code line.
          (unless stay                 ; Keep moving if we not already
            (while (looking-at "[ \t]*#") ; have a declaration.
              (forward-line)))))
      ;; Insert the declaration statement KEYWORD VAR ; at point.
      ;; If point is at beginning of line, insert a newline at end.
      ;; NOTE: It might be better to look whether there is any following text.
      (let ((new-line (bolp)))
        (insert keyword " " var "; ")
        (when new-line
          (newline)
          (forward-line -1)))
      (maplev-indent-line))))

(defun maplev-add-local-variable (var)
  "Add VAR to the current procedure's local statement.
Interactively, VAR defaults to identifier point is on."
  (interactive (list (maplev-ident-around-point-interactive
                      "Local variable")))
  (maplev-add-variable "local" var))

(defun maplev-add-global-variable (var)
  "Add VAR to the current procedure's local statement.
Interactively, VAR defaults to identifier point is on."
  (interactive (list (maplev-ident-around-point-interactive
                      "Global variable")))
  (maplev-add-variable "global" var))

(defun maplev-add-export-variable (var)
  "Add VAR to the current module's export statement.
Interactively, VAR defaults to identifier point is on."
  (interactive (list (maplev-ident-around-point-interactive
                      "Exported variable")))
  (maplev-add-variable "export" var))

(defun maplev-add-variable (keyword var)
  "To the current procedure's KEYWORD declaration add VAR."
  (save-excursion
    (maplev-beginning-of-defun)
    (goto-char (maplev--scan-lists 1))
    (maplev-add-declaration keyword var)))

(defun maplev-delete-declaration (keyword vars &optional leave-one)
  "From the KEYWORD declaration delete occurrences of VARS.
VARS must be eiter a string or a list of strings. If optional
argument LEAVE-ONE is non-nil, then one occurrence of VARS is left.
The entire statement is deleted if it is left with no variables."
  (save-excursion
    (when (maplev--goto-declaration keyword)
      (maplev-delete-vars (point) (maplev--statement-terminator)
                          vars leave-one)
      ;; remove entire KEYWORD statement, if empty
      (let (case-fold-search)
        (when (looking-at (concat keyword "[ \t\n]*[;:]\\([ \t#]*$\\)?"))
          (delete-region (match-beginning 0) (match-end 0))
          (maplev-delete-whitespace t))))))

(defun maplev-delete-vars-old (start end vars &optional leave-one)
  "In region between START and END delete occurrences of VARS.
VARS must be either a string or a list of strings. If optional
argument LEAVE-ONE is non-nil, then one occurrence of VARS is left."
  (let (case-fold-search lo)
    (save-excursion
      (save-restriction
        (narrow-to-region start end)
        (if (stringp vars) (setq vars (list vars)))
        (while vars
          (setq lo leave-one)
          (goto-char (point-min))
          (while (maplev--re-search-forward
                  (concat "\\<" (car vars) "\\>"
                          ;; Add optional type declarations.  I don't know
                          ;; how to make this robust, a type
                          ;; declaration can have commas and closing
                          ;; parentheses.
                          "\\(\\s-*::\\s-*[^,:;)]+\\)?")
                  nil t)
            (if lo
                (setq lo nil)
              (delete-region (match-beginning 0) (match-end 0))
              (maplev-delete-whitespace)
              (when (or (maplev--re-search-forward  "," nil t)
                        (maplev--re-search-backward "," nil t))
                (delete-region (match-beginning 0) (match-end 0))
                (maplev-delete-whitespace))))
          (setq vars (cdr vars)))))))

(defun maplev-delete-vars (start end vars &optional leave-one)
  "In region between START and END delete occurrences of VARS.
VARS must be either a string or a list of strings. If optional
argument LEAVE-ONE is non-nil, then one occurrence of VARS is left."
  (let ((parse-sexp-ignore-comments)
        case-fold-search lo )
    (save-excursion
      (save-restriction
        (narrow-to-region start end)
        (if (stringp vars) (setq vars (list vars)))
        (while vars
          (setq lo leave-one)
          (goto-char (point-min))
          (while (maplev--re-search-forward
                  (concat "\\<" (car vars) "\\>")
                  nil t)
            (if lo
                (setq lo nil)
              (delete-region (match-beginning 0) (match-end 0))
              (maplev-delete-whitespace)

              ;; Remove optional type declaration
              
              (when (looking-at "::\\s-*") 
                ;; Skip past type declaration operator (::)
                ;; so looking-at won't match them.
                (goto-char (match-end 0)) 
                (delete-region (match-beginning 0)
                               (progn 
                                 ;; Unless looking at an argument separator,
                                 ;; statement terminator, or closing
                                 ;; parenthesis, or at end of buffer, move
                                 ;; forward over a balanced expression.
                                 ;;
                                 ;; This nees modification to handle comments,
                                 ;; esp. with leading commas.
                                 (while (and (not (looking-at "[ \t\f\n]*[,;:#)]"))
                                             (/= (point) (point-max)))
                                   (forward-sexp))
                                 (point))))
              ;; Remove separating comma
              (when (or (maplev--re-search-backward "," nil t)
                        (maplev--re-search-forward  "," nil t))
                (delete-region (match-beginning 0) (match-end 0))
                (maplev-delete-whitespace))))
          (setq vars (cdr vars)))))))

;;}}}
;;{{{ Templates

(defun maplev--template-proc-module (function name args description)
  "Insert a template for a Maple FUNCTION \(\"proc\" or \"module\"\).
Use NAME, ARGUMENTS, and DESCRIPTION. Move point to body of FUNCTION.

If NAME equals \"\" then the function is anonymous,
no assignment operator is inserted and the closing
end statement is not terminated with a colon.

ARGS are inserted as formal arguments in the function statement.

If `maplev-insert-copyright-flag' is non-nil, then insert a copyright
as an option statement.  Confirmation is required for an anonymous
function.

Unless DESCRIPTION equals \"\" it is inserted as a description statement.

If `maplev-comment-end-flag' is non-nil, and the function is not
anonymous, then NAME is inserted as a comment following the closing
end statement.  Point is moved to the start of the function body."
  (let ((fname (not (string= name ""))))
    ;; Insert assignment if function has a name
    (when fname
      (setq name (maplev--string-to-name name))
      (insert name " := "))
    (insert function
            (make-string maplev-variable-spacing ?\ )
            "(" args ")")          ; Insert function, with formal args

    ;; Copyright notice
    (when (and maplev-insert-copyright-flag
               (or fname (y-or-n-p "Insert copyright? ")))
      (insert "\noption `Copyright (C) "
              (format-time-string "%Y" (current-time))
              " by " maplev-copyright-owner ". All rights reserved.`;"))

    ;; description
    (unless (string= description "")
      (insert "\ndescription " maplev-description-quote-char
              description maplev-description-quote-char ";"))

    (insert "\n\nend")
    (when fname
      (insert ":")
      (if maplev-comment-end-flag
          (insert maplev-template-end-comment name)))
    (forward-line -1)                   ; Move point to start of body
    ;; bug in maplev-current-defun:
    ;; it doesn't work yet with anonymous procedures
    (when fname (maplev-indent-procedure))))

(defun maplev-template-proc (name args description)
  "Insert a template for a Maple procedure and move point to its body.
Prompt for the NAME, ARGS, and DESCRIPTION.  See `maplev-template'."
  (interactive "*sName (return for anonymous) \nsArguments: \nsDescription: ")
  (maplev--template-proc-module "proc" name args description))

(defun maplev-template-module (name args description)
  "Insert a template for a Maple module and move point to its body.
Prompt for the NAME, ARGUMENTS, and DESCRIPTION.  See `maplev-template'."
  (interactive "*sName (return for anonymous) \nsArguments: \nsDescription: ")
  (maplev--template-proc-module "module" name args description))

(defun maplev-template-use-statement (exprseq)
  "Insert a template for a Maple use statement and move point to its 
first statement.  Prompt fo the EXPRSEQ."
  (interactive "*sExpression Sequence: ")
  (insert "use " exprseq " in")
  (maplev-indent-newline)
  (insert "\nend use")
  (maplev-indent-line)
  (forward-line -1)
  (maplev-indent-line))
  

;;}}}
;;{{{ Completion

;; Define functions for completing Maple symbols.
;;
;; It is easy enough to collect all the symbols defined in
;; ?index/functions and ?index/packages.  However, we would really
;; like to complete on the exports of particular Maple modules.  It is
;; not practical, nor useful, to complete on all exports of all
;; modules, not is it straightforward to provide intelligent
;; completion, that is, inside a `use ' statement complete on
;; the exports of .  A reasonable workaround is to provide a
;; function that allows the user to add the exports of selected
;; modules to the completion list.

(defun maplev-add-exports-of-module-at-point (module)
  "Add the exports of MODULE at point to `maplev-completion-alist'.
The real work is done by `maplev-complete-on-module-exports'."
  (interactive (list (maplev-ident-around-point-interactive
                      "Complete on Maple exports of module")))
  (maplev-complete-on-module-exports module))

(defun maplev-complete-on-module-exports (module)
  "Add the exports of MODULE to `maplev-completion-alist'."

  ;; First, ensure that `maplev-completion-alist' is assigned.
  (maplev--generate-initial-completion-alist)
  (save-current-buffer
    (set-buffer (maplev--cmaple-buffer))
    (save-restriction
      ;; Print each export of module on a separate line in a narrowed buffer.
      (narrow-to-region (point-max) (point-max))
      (maplev-cmaple--send-string 
       (maplev--cmaple-process)
       (concat "seq(lprint(e),e=exports(" module "));"))
      (maplev-cmaple--wait 3)
      ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
      ;; Delete the input line.
      (delete-region 
       (goto-char (point-min))
       (progn (forward-line) (point)))
      ;; Check that no Maple error occurred.
      ;; If so, assume that module is not an actual Maple module
      ;; and print a temporary message at the bottom of the screen.
      (if (looking-at "Error")
          (progn
            (ding)
            (message "The argument `%s' is not a Maple module" module)
            (sit-for 2))
        ;; Initialize completions to those previously assigned
        (let ((completions (car (cdr (assoc maplev-release maplev-completion-alist)))))
          ;; Goto end of buffer and read upwards, a line at a time,
          ;; adding it to the exports list.
          (goto-char (point-max))
          (while (zerop (forward-line -1))
            (setq completions
                  (cons (cons (buffer-substring-no-properties
                               (point) (line-end-position))
                              nil)
                        completions)))
          ;; Replace the completion alist.
          (setcar (cdr (assoc maplev-release maplev-completion-alist)) 
                  (remove-duplicates
                   (sort completions (lambda (a b) (string< (car a) (car b))))
                   :test (lambda (a b) (string= (car a) (car b)))))))
      ;; Delete the output from the cmaple buffer.
      (delete-region (point-min) (point-max)))))

;; (setq maplev-completion-alist nil)

(defun maplev--generate-initial-completion-alist ()
  "Generate `maplev-completion-alist' from the index/function and
index/package help pages.  If it already exists, do nothing."
  (unless (assoc maplev-release maplev-completion-alist)

    ;; To make it easy to pick out the package names from the
    ;; index/package help page, set the interface variable
    ;; `screenwidth' to infinity and save the original value in the
    ;; elisp variable screenwidth.
        
    (let ((screenwidth (maplev-cmaple-direct 
                        "lprint(interface('screenwidth'=infinity));" t))
          completions)
      (unwind-protect
          (save-current-buffer
            (set-buffer (get-buffer-create (maplev--help-buffer)))

            ;; Process help node "index/function".
            (maplev-cmaple--wait 3)
            ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
            (maplev-help-show-topic "index/function" t)
            (maplev-cmaple--wait 3)
            ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
            (save-restriction
              (narrow-to-region 
               (re-search-forward "^    ")
               (save-excursion (goto-char (point-max))
                               (re-search-backward "See Also")))
              (goto-char (point-max))
              (while (forward-word -1)
                (setq completions
                      (cons (cons (buffer-substring-no-properties
                                   (point)
                                   (save-excursion (forward-word 1) (point)))
                                  nil)
                            completions))))

            ;; Process help node "index/package".
            ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
            (maplev-cmaple--wait 3)
            (maplev-help-show-topic "index/package" t)
            ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
            (maplev-cmaple--wait 3)
            (save-restriction
              (narrow-to-region 
               (progn (re-search-forward "^    \\w" nil t) 
                      (goto-char (match-beginning 0))) ; first package
               (progn (re-search-forward "^-" nil t)
                      (goto-char (match-beginning 0)))) ; bullets after packages
              (goto-char (point-max))
              ;; Assign a regular expression to match each package name;
              ;; the name is matched by the first group in regexp.
              (let ((regexp (concat 
                             "^\\s-+"   ; whitespace at start of line
                             "\\(" maplev--name-re "\\)"))) ; package name (first group)
                (while (re-search-backward regexp nil 'move)
                  (setq completions
                        (cons (cons (buffer-substring-no-properties 
                                     (match-beginning 1) (match-end 1))
                                    nil)
                              completions)))))
            ;; Delete both help pages.
            (maplev-history-delete-item)
            ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
            (maplev-cmaple--wait 3)
            (maplev-history-delete-item))

        ;; Assign `maplev-completion-alist'.  Sort the completions.
        (setq completions (sort completions (lambda (a b) (string< (car a) (car b))))
              maplev-completion-alist
              (cons (cons maplev-release (list completions))
                    maplev-completion-alist)))
      ;; Restore the original interface screenwidth.
      (maplev-cmaple-direct (concat "interface('screenwidth'=" screenwidth ");") t))))


(defun maplev--completion (word predicate mode)
  "Generate minibuffer completion using maple function names.
For the meaning of args see Info node `(elisp)Programmed Completion'."
  ;; Make sure we are using the correct value of maplev-release.
  ;; (Inside the minibuffer maplev-release equals maplev-default-release.)
  (let ((maplev-release maplev-completion-release))
    (maplev--generate-initial-completion-alist)
    (let ((possibilities (cadr (assoc maplev-release maplev-completion-alist))))
      (cond ((eq mode t)
             (all-completions word possibilities predicate))
            ((not mode)
             (try-completion word possibilities predicate))
            ((eq mode 'lambda)
             (assoc word possibilities))))))

(defun maplev-complete-symbol (&optional prefix)
  "Perform completion on maple symbol preceding point.
Compare that symbol against `maplev-completion-alist'."
  ;; Code borrowed from lisp-complete-symbol.
  (interactive)
  (let* ((end (point))
	 (beg (save-excursion
                (backward-sexp 1)
                (point)))
	 (pattern (buffer-substring-no-properties beg end))
         (maplev-completion-release maplev-release)
	 (completion (try-completion pattern 'maplev--completion)))
    (cond ((eq completion t))
	  ((null completion)
	   (message "Can't find completion for \"%s\"" pattern)
	   (ding))
	  ((not (string= pattern completion))
	   (delete-region beg end)
	   (insert completion))
	  (t
	   (message "Making completion list...")
	   (let ((list (sort (all-completions pattern 'maplev--completion)
                             'string<)))
	     (with-output-to-temp-buffer "*Completions*"
	       (display-completion-list list)))
	   (message "Making completion list...%s" "done")))))

;;}}}

;;{{{ Font lock

(defvar maplev-preprocessor-face   'maplev-preprocessor-face
  "*Face name for Maple preprocessor directives.")

(defface maplev-preprocessor-face
  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
    (((class color)     (background light)) (:foreground "dark orange"))
    (((class color)     (background dark))  (:foreground "orange"))
    (t (:bold t)))
  "Font lock mode face used for Maple preprocessor directives."
  :group 'maplev-faces)


(defconst maplev--reserved-words-alist
  '((3 . ("and"  "by"   "do"        "done"   "elif"
          "else" "end"  "fi"        "for"    "from"
          "if"   "in"   "intersect" "local"  "minus"
          "mod"  "not"  "od"        "option" "options"
          "or"   "proc" "quit"      "read"   "save"
          "stop" "then" "to"        "union"  "while"
          "description" "local" "global"))
    (4 . ("and"  "by"   "do"        "done"   "elif"
          "else" "end"  "fi"        "for"    "from"
          "if"   "in"   "intersect" "local"  "minus"
          "mod"  "not"  "od"        "option" "options"
          "or"   "proc" "quit"      "read"   "save"
          "stop" "then" "to"        "union"  "while"
          "description" "local" "global"))
    (5 . ("and"  "by"   "do"        "done"   "elif"
          "else" "end"  "fi"        "for"    "from"
          "if"   "in"   "intersect" "local"  "minus"
          "mod"  "not"  "od"        "option" "options"
          "or"   "proc" "quit"      "read"   "save"
          "stop" "then" "to"        "union"  "while"
          "description" "local" "global"))
    (6 . ("and"     "break" "by"     "catch" "description" "do"        "done"
          "elif"    "else"  "end"    "error" "export"      "fi"        "finally"
          "for"     "from"  "global" "if"    "in"          "intersect" "local"
          "minus"   "mod"   "module" "next"  "not"         "od"        "option"
          "options" "or"    "proc"   "quit"  "read"        "return"    "save"
          "stop"    "then"  "to"     "try"   "union"       "use"       "while"))
    (7 . ("and"     "assuming"  "break"  "by"     "catch"
          "description" "do"    "done"   "elif"   "else"
          "end"     "error"     "export" "fi"     "finally"
          "for"     "from"      "global" "if"     "implies"
          "in"      "intersect" "local"  "minus"  "mod"
          "module"  "next"      "not"    "od"     "option"
          "options" "or"        "proc"   "quit"   "read"
          "return"  "save"      "stop"   "subset" "then"
          "to"     "try"        "union"  "use"    "while"
          "xor"))
    (8 . ("and"     "assuming"  "break"  "by"     "catch"
          "description" "do"    "done"   "elif"   "else"
          "end"     "error"     "export" "fi"     "finally"
          "for"     "from"      "global" "if"     "implies"
          "in"      "intersect" "local"  "minus"  "mod"
          "module"  "next"      "not"    "od"     "option"
          "options" "or"        "proc"   "quit"   "read"
          "return"  "save"      "stop"   "subset" "then"
          "to"     "try"        "union"  "use"    "while"
          "xor"))
    (9 . ("and"     "assuming"  "break"  "by"     "catch"
          "description" "do"    "done"   "elif"   "else"
          "end"     "error"     "export" "fi"     "finally"
          "for"     "from"      "global" "if"     "implies"
          "in"      "intersect" "local"  "minus"  "mod"
          "module"  "next"      "not"    "od"     "option"
          "options" "or"        "proc"   "quit"   "read"
          "return"  "save"      "stop"   "subset" "then"
          "to"     "try"        "union"  "use"    "while"
          "xor"))
    (10 . ("and"     "assuming"  "break"  "by"     "catch"
          "description" "do"    "done"   "elif"   "else"
          "end"     "error"     "export" "fi"     "finally"
          "for"     "from"      "global" "if"     "implies"
          "in"      "intersect" "local"  "minus"  "mod"
          "module"  "next"      "not"    "od"     "option"
          "options" "or"        "proc"   "quit"   "read"
          "return"  "save"      "stop"   "subset" "then"
          "to"     "try"        "union"  "use"    "uses" "while"
          "xor"))
    (11 . ("and"     "assuming"  "break"  "by"     "catch"
          "description" "do"    "done"   "elif"   "else"
          "end"     "error"     "export" "fi"     "finally"
          "for"     "from"      "global" "if"     "implies"
          "in"      "intersect" "local"  "minus"  "mod"
          "module"  "next"      "not"    "od"     "option"
          "options" "or"        "proc"   "quit"   "read"
          "return"  "save"      "stop"   "subset" "then"
          "to"     "try"        "union"  "use"    "uses" "while"
          "xor"))
    )
  "Alist of Maple reserved words.  The key is the major release.")

(defconst maplev--special-words-re
  (eval-when-compile
    (maplev--list-to-word-re
     (list "args" "nargs" "procname" "RootOf" "Float" "thismodule")))
  "Regex of special words in Maple.")

(defconst maplev--initial-variables-re
  (eval-when-compile
    (maplev--list-to-word-re
     (list "Catalan" "true" "false" "FAIL" "infinity" "Pi" "gamma"
           "integrate" "libname" "NULL" "Order" "printlevel" "lasterror"
           "`mod`" "Digits" "constants" "undefined" "I"
           "UseHardwareFloats"
           "Testzero" "Normalizer" "NumericEventHandlers"
           "Rounding" "`index/newtable`")))
  "Regexp of global, environmental variables and constants.")

(defconst maplev--preprocessor-directives-re
  (eval-when-compile
    (concat "^\\$\\(" 
            (regexp-opt (list "include" "define" "undef" "ifdef" "ifndef" "else" "endif" ))
            "\\)"))
  "Regex of preprocessor directives.")

;; Currently the backquoted builtin functions are font-locked as
;; quoted names rather than as builtin functions.  Fixing this
;; requires pulling them out.

(defconst maplev--builtin-types-alist
  '((8. ("`::`" "`..`" "`!`"
         "algebraic" "anyfunc" "anything" "atomic"
         "boolean"
         "complex" "constant" "cx_infinity" "cx_zero"
         "embedded_axis" "embedded_imaginary" "embedded_real"
         "equation" "even" "extended_numeric" "extended_rational"
         "finite" "float" "fraction" "function"
         "identical" "imaginary" "indexable" "indexed" "integer"
         "list" "literal"
         "module" "moduledefinition"
         "name" "neg_infinity" "negative" "negint" "negzero"
         "nonnegative" "nonnegint" "nonposint" "nonpositive"
         "nonreal" "numeric" "odd"
         "polynom" "pos_infinity" "posint" "positive" "poszero"
         "procedure" "protected"
         "radical" "range" "rational" "ratpoly" "real_infinity"
         "realcons" "relation"
         "sequential" "set" "sfloat" "specfunc" "string" "symbol"
         "tabular" "uneval" "zppoly")))
  "Alist of builtin Maple types.  Currently not used.")

(defconst maplev--builtin-functions-alist
  '((3 . ("`$`"   "ERROR"   "Im"   "RETURN"  "Re"   "SearchText"
          "abs" "addressof" "alias"  "anames" "appendto"
          "array" "assemble" "assigned" "callback" "cat"
          "coeff" "coeffs" "convert" "debugopts" "degree"
          "diff" "disassemble" "divide" "entries" "eval"
          "evalb" "evalf" "`evalf/hypergeom`" "evalhf" "evaln"
          "expand" "frontend" "gc" "genpoly" "goto"
          "has" "hastype" "icontent" "`if`" "igcd"
          "ilog10" "indets" "indices" "`int/series`" "intersect"
          "iquo" "irem" "isqrt" "lcoeff" "ldegree"
          "length" "lexorder" "lprint" "macro" "map"
          "max" "maxnorm" "member" "min" "minus"
          "modp" "modp1" "mods" "nops" "normal"
          "numboccur" "numer" "op" "order" "parse"
          "pointto" "print" "printf" "protect" "readlib"
          "readline" "searchtext" "select" "seq" "series"
          "sign" "sort" "sscanf" "ssystem" "subs"
          "subsop" "substring" "system" "table" "taylor"
          "tcoeff" "time" "traperror" "trunc" "type"
          "unames" "`union`" "unprotect" "userinfo" "words"
          "writeto" ))
    (4 . ("`$`" "`*`" "`+`" "ASSERT" "DEBUG"
          "ERROR" "Im" "MorrBrilCull" "RETURN" "Re"
          "SearchText" "abs" "add" "addressof" "alias"
          "anames" "appendto" "array" "assemble" "assigned"
          "attributes" "callback" "cat" "coeff" "coeffs"
          "convert" "debugopts" "degree" "denom" "diff"
          "disassemble" "divide" "entries" "eval" "evalb"
          "evalf" "`evalf/hypergeom`" "evalhf" "evaln" "expand"
          "frontend" "gc" "genpoly" "getuserinterface" "goto"
          "has" "hastype" "icontent" "`if`" "igcd"
          "ilog10" "indets" "indices" "inner" "`int/series`"
          "intersect" "iolib" "iquo" "irem" "isqrt"
          "`kernel/transpose`" "kernelopts" "lcoeff" "ldegree" "length"
          "lexorder" "lprint" "macro" "map" "map2"
          "max" "maxnorm" "member" "min" "minus"
          "modp" "modp1" "mods" "mul" "nops"
          "normal" "numboccur" "numer" "op" "order"
          "parse" "pointto" "print" "readlib" "searchtext"
          "select" "seq" "series" "setattribute" "setuserinterface"
          "sign" "sort" "ssystem" "subs" "subsop"
          "substring" "system" "table" "taylor" "tcoeff"
          "time" "traperror" "trunc" "type" "typematch"
          "unames" "`union`" "userinfo" "writeto"))
    (5 . ("`$`" "`*`" "`**`" "`+`" "`<`"
          "`<=`" "`<>`" "`=`" "`>`" "`>=`"
          "`^`" "ASSERT" "DEBUG" "ERROR" "Im"
          "MorrBrilCull" "RETURN" "Re" "SearchText" "abs"
          "add" "addressof" "alias" "anames" "appendto"
          "array" "assemble" "assigned" "attributes" "call"
          "callback" "cat" "coeff" "coeffs" "convert"
          "crinterp" "debugopts" "define" "degree" "denom"
          "diff" "disassemble" "divide" "entries" "eval"
          "evalb" "evalf" "`evalf/hypergeom/kernel`" "evalhf" "evaln"
          "expand" "frontend" "gc" "genpoly" "getuserinterface"
          "goto" "has" "hastype" "hfarray" "icontent"
          "`if`" "igcd" "ilog10" "indets" "indices"
          "inner" "`int/series`" "intersect" "iolib" "iquo"
          "irem" "isqrt" "`kernel/transpose`" "kernelopts" "lcoeff"
          "ldegree" "length" "lexorder" "lprint" "macro"
          "map" "map2" "max" "maxnorm" "member"
          "min" "minus" "modp" "modp1" "mods"
          "mul" "nops" "normal" "numboccur" "numer"
          "op" "order" "parse" "pointto" "print"
          "readlib" "searchtext" "select" "seq" "series"
          "setattribute" "setuserinterface" "sign" "sort" "ssystem"
          "subs" "subsop" "substring" "system" "table"
          "taylor" "tcoeff" "time" "timelimit" "traperror"
          "trunc" "type" "typematch" "unames" "`union`"
          "userinfo" "writeto"))
    (6 . ("`^`" "`||`" "`$`" "`*`" "`**`" "`+`"
          "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`"
          "ASSERT" "Array" "ArrayOptions" "CopySign"
          "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow"
          "ERROR" "EqualEntries" "EqualStructure" "FromInert"
          "Im" "MPFloat" "MorrBrilCull" "NextAfter"
          "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus"
          "OrderedNE" "RETURN" "Re"
          "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText"
          "TRACE" "ToInert" "Unordered"
          "abs" "add" "addressof" "alias" "anames" "and" "appendto" "array"
          "assemble" "assigned" "attributes" "bind"
          "call_external" "callback" "cat" "coeff" "coeffs" "conjugate" "convert"
          "crinterp" "debugopts" "define_external" "degree" "denom" "diff" "disassemble"
          "inner" "divide" "done" "entries" "eval" "evalb"
          "evalf" "evalgf1" "evalhf" "evaln" "expand" "exports"
          "frem" "frontend" "gc" "genpoly" "goto"
          "has" "hastype" "hfarray" "`evalf/hypergeom/kernel`"
          "icontent" "if" "igcd" "ilog10" "ilog2" "indets" "indices"
          "intersect" "`int/series`" "iolib" "iquo" "irem" "isqrt"
          "kernelopts" "lcoeff" "ldegree" "length" "lexorder" "lhs" "lprint"
          "macro" "map" "map2" "max" "maxnorm" "member" "min" "minus"
          "modp" "modp1" "modp2" "mods" "mul" "mvMultiply"
          "negate" "nops" "normal" "not" "numboccur" "numer"
          "op" "or" "order" "parse" "pointto" "print" "quit"
          "readlib" "remove" "rhs" "rtable" "rtableInfo" "rtable_indfns"
          "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims"
          "rtable_num_elems" "rtable_options" "rtable_scanblock"
          "rtable_sort_indices" "searchtext" "select" "selectremove"
          "seq" "series" "setattribute" "sign" "sort" "ssystem" "stop"
          "streamcall" "subs" "subsop" "substring" "system"
          "table" "taylor" "tcoeff" "time" "timelimit"
          "`kernel/transpose`" "traperror" "trunc" "type" "typematch"
          "unames" "unbind" "union" "userinfo" "writeto"))
    (7 . ("`$`" "`*`" "`**`" "`+`" "`<`" "`<=`"
          "`<>`" "`=`" "`>`" "`>=`" "`^`" "`||`"
          "ASSERT" "Array" "ArrayOptions" "CopySign"
          "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow"
          "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im"
          "MPFloat" "MorrBrilCull" "NextAfter" "NumericClass" "NumericEvent"
          "NumericEventHandler" "NumericStatus" "OrderedNE" "RETURN" "Re"
          "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText"
          "TRACE" "ToInert" "Unordered" "_treeMatch" "_unify"
          "_xml" "`evalf/hypergeom/kernel`" "`int/series`" "`kernel/transpose`"
          "abs" "add" "addressof" "alias" "anames" "and"
          "appendto" "array" "assemble" "assigned" "attributes"
          "bind" "call_external" "callback" "cat" "coeff"
          "coeffs" "conjugate" "convert" "crinterp" "debugopts"
          "define_external" "degree" "denom" "diff" "disassemble"
          "divide" "dlclose" "done" "entries" "eval"
          "evalb" "evalf" "evalgf1" "evalhf" "evaln"
          "expand" "exports" "factorial" "frem" "frontend"
          "gc" "genpoly" "goto" "has" "hastype"
          "hfarray" "icontent" "if" "igcd" "ilog10"
          "ilog2" "implies" "indets" "indices" "inner"
          "intersect" "iolib" "iquo" "irem" "isqrt"
          "kernelopts" "lcoeff" "ldegree" "length" "lexorder"
          "lhs" "lprint" "macro" "map" "map2"
          "max" "maxnorm" "member" "min" "minus"
          "modp" "modp1" "modp2" "mods" "mul"
          "mvMultiply" "negate" "nops" "normal" "not"
          "numboccur" "numer" "op" "or" "order"
          "parse" "pointto" "print" "quit" "readlib"
          "remove" "rhs" "rtable" "rtableInfo" "rtable_indfns"
          "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims"
          "rtable_num_elems" "rtable_options" "rtable_scanblock"
          "rtable_sort_indices" "searchtext" "select" "selectremove"
          "seq" "series" "setattribute" "sign" "sort" "ssystem"
          "stop" "streamcall" "subs" "subset" "subsop" "substring"
          "system" "table" "taylor" "tcoeff" "time" "timelimit"
          "traperror" "trunc" "type" "typematch" "unames" "unbind"
          "union" "userinfo" "writeto" "xor" ))
    (8 . ("`$`" "`*`" "`**`" "`+`" "`<`" "`<=`"
          "`<>`" "`=`" "`>`" "`>=`" "`^`" "`||`"
          "ASSERT" "Array" "ArrayOptions" "CopySign"
          "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow"
          "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im"
          "MPFloat" "MorrBrilCull" "NextAfter" "NumericClass" "NumericEvent"
          "NumericEventHandler" "NumericStatus" "OrderedNE" "RETURN" "Re"
          "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText"
          "TRACE" "ToInert" "Unordered" "_jvm" "_maplet" "_treeMatch" "_unify"
          "_xml" "`evalf/hypergeom/kernel`" "`int/series`" "`kernel/transpose`"
          "abs" "add" "addressof" "alias" "anames" "and" "andmap"
          "appendto" "array" "assemble" "assigned" "attributes"
          "bind" "call_external" "callback" "cat" "coeff"
          "coeffs" "conjugate" "convert" "crinterp" "debugopts"
          "define_external" "degree" "denom" "diff" "disassemble"
          "divide" "dlclose" "done" "entries" "eval"
          "evalb" "evalf" "evalgf1" "evalhf" "evaln"
          "expand" "exports" "factorial" "frem" "frontend"
          "gc" "genpoly" "goto" "has" "hastype"
          "hfarray" "icontent" "if" "igcd" "ilog10"
          "ilog2" "implies" "indets" "indices" "inner"
          "intersect" "iolib" "iquo" "irem" "isqrt"
          "kernelopts" "lcoeff" "ldegree" "length" "lexorder"
          "lhs" "lprint" "macro" "map" "map2"
          "max" "maxnorm" "member" "min" "minus"
          "modp" "modp1" "modp2" "mods" "mul"
          "mvMultiply" "negate" "nops" "normal" "not"
          "numboccur" "numer" "op" "or" "order" "ormap"
          "parse" "pointto" "print" "quit" "readlib"
          "remove" "rhs" "rtable" "rtableInfo" "rtable_indfns"
          "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims"
          "rtable_num_elems" "rtable_options" "rtable_scanblock"
          "rtable_sort_indices" "searchtext" "select" "selectremove"
          "seq" "series" "setattribute" "sign" "sort" "ssystem"
          "stop" "streamcall" "subs" "subset" "subsop" "substring"
          "system" "table" "taylor" "tcoeff" "time" "timelimit"
          "traperror" "trunc" "type" "typematch" "unames" "unbind"
          "union" "userinfo" "writeto" "xor" ))
    (9 . ("`$`" "`*`" "`**`" "`+`" "`..`" "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`" 
          "ASSERT" "Array" "ArrayOptions" "CopySign" 
          "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" 
          "ERROR" "EqualEntries" "EqualStructure" "FromInert" 
          "Im" "MPFloat" "MorrBrilCull" "NextAfter" "Normalizer" 
          "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus" 
          "OrderedNE" "RETURN" "Re" "SFloatExponent" "SFloatMantissa" 
          "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" 
          "Unordered" "UpdateSource" "`^`" 
          "_jvm" "_maplet" "_treeMatch" "_unify" "_xml" 
          "abs" "add" "addressof" "alias" "anames" "and" "andmap" 
          "appendto" "array" "assemble" "assigned" "attributes" 
          "bind" "call_external" "callback" "cat" "coeff" "coeffs" 
          "conjugate" "convert" "crinterp" "debugopts" "define_external" 
          "degree" "denom" "diff" "disassemble" "divide" "dlclose" "done" 
          "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`" 
          "evalgf1" "evalhf" "evaln" "expand" "exports" "factorial" "frem" 
          "frontend" "gc" "genpoly" "gmp_isprime" "goto" "has" "hastype" "hfarray" 
          "icontent" "if" "igcd" "ilog10" "ilog2" "implies" "indets" 
          "indices" "inner" "`int/series`" "intersect" "iolib" "iquo" "irem" 
          "is_gmp" "isqrt" "`kernel/transpose`" "lcoeff" "ldegree" "length" 
          "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm" 
          "member" "min" "minus" "mod" "modp" "modp1" "modp2" "mods" 
          "mul" "mvMultiply" "negate" "nops" "normal" "not" "numboccur" 
          "numer" "op" "or" "order" "ormap" "parse" "piecewise" 
          "pointto" "print" "quit" "readlib" "reduce_opr" "remove" 
          "rhs" "rtable" "rtableInfo" "rtable_eval" "rtable_indfns" 
          "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims" 
          "rtable_num_elems" "rtable_options" "rtable_scanblock" 
          "rtable_sort_indices" "rtable_zip" "searchtext" "select" 
          "selectremove" "seq" "series" "setattribute" "sign" "sort" 
          "ssystem" "stop" "streamcall" "subs" "subset" "subsop" 
          "substring" "system" "table" "taylor" "tcoeff" "time" 
          "timelimit" "traperror" "trunc" "type" "typematch" 
          "unames" "unbind" "union" "userinfo" "writeto" "xor" "`||`"))
    (10 . ("`$`" "`*`" "`**`" "`+`" "`..`" "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`" "`?()`" "`?[]`"
           "ASSERT" "Array" "ArrayOptions" "CopySign" 
           "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" 
           "ERROR" "EqualEntries" "EqualStructure" "FromInert" 
           "Im" "MPFloat" "MorrBrilCull" "NextAfter" "Normalizer" 
           "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus" 
           "OrderedNE" "RETURN" "Re" "SDMPolynom" "SFloatExponent" "SFloatMantissa" 
           "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" 
           "Unordered" "UpdateSource" "`[]`" "`^`"
           "_jvm" "_maplet" "_treeMatch" "_unify" "_xml" 
           "abs" "add" "addressof" "alias" "anames" "and" "andmap" 
           "appendto" "array" "assemble" "assigned" "attributes" 
           "bind" "call_external" "callback" "cat" "coeff" "coeffs" 
           "conjugate" "convert" "crinterp" "debugopts" "define_external" 
           "degree" "denom" "diff" "disassemble" "divide"
           "dlclose" "done" "entries" "eval" "evalb" "evalf"
           "evalf/hypergeom/kernel" "evalgf1" "evalhf" "evaln" "expand"
           "exports" "factorial" "frem" "frontend" "gc" "genpoly" "gmp_isprime"
           "goto" "has" "hastype" "hfarray" "icontent" "if" "igcd" "ilog10"
           "ilog2" "implies" "indets" "indices" "inner" "int/series"
           "intersect" "iolib" "iquo" "irem" "is_gmp" "isqrt"
           "kernel/transpose" "kernelopts" "lcoeff" "ldegree" "length"
           "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm"
           "member" "min" "minus" "mod" "modp" "modp1" "modp2" "mods" "mul"
           "mvMultiply" "negate" "nops" "normal" "not" "numboccur" "numer"
           "op" "or" "order" "ormap" "overload" "parse" "piecewise" "pointto"
           "print" "quit" "readlib" "reduce_opr" "remove" "rhs" "rtable"
           "rtableInfo" "rtable_convolution" "rtable_eval" "rtable_histogram"
           "rtable_indfns" "rtable_is_zero" "rtable_normalize_index"
           "rtable_num_dims" "rtable_num_elems" "rtable_options" "rtable_redim"
           "rtable_scale" "rtable_scanblock" "rtable_sort_indices" "rtable_zip"
           "savelib" "searchtext" "select" "selectremove" "seq" "series"
           "setattribute" "sign" "sort" "ssystem" "stop" "streamcall" "subs"
           "subset" "subsop" "substring" "system" "table" "taylor" "tcoeff"
           "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames"
           "unbind" "union" "userinfo" "writeto" "xor" "`{}`" "`||`"))
    (11 . ("`$`" "`*`" "`**`" "`+`" "`..`" "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`" "`?()`" "`?[]`"
           "ASSERT" "Array" "ArrayOptions" "CopySign" 
           "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" 
           "ERROR" "EqualEntries" "EqualStructure" "FromInert" 
           "Im" "MPFloat" "MorrBrilCull" "NextAfter" "Normalizer" 
           "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus" 
           "OrderedNE" "RETURN" "Re" "SDMPolynom" "SFloatExponent" "SFloatMantissa" 
           "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" 
           "Unordered" "UpdateSource" "`[]`" "`^`"
           "_jvm" "_maplet" "_treeMatch" "_unify" "_xml" 
           "abs" "add" "addressof" "alias" "anames" "and" "andmap" 
           "appendto" "array" "assemble" "assigned" "attributes" 
           "bind" "call_external" "callback" "cat" "coeff" "coeffs" 
           "conjugate" "convert" "crinterp" "debugopts" "define_external" 
           "degree" "denom" "diff" "disassemble" "divide"
           "dlclose" "done" "entries" "eval" "evalb" "evalf"
           "evalf/hypergeom/kernel" "evalgf1" "evalhf" "evaln" "expand"
           "exports" "factorial" "frem" "frontend" "gc" "genpoly" "gmp_isprime"
           "goto" "has" "hastype" "hfarray" "icontent" "if" "igcd" "ilog10"
           "ilog2" "implies" "indets" "indices" "inner" "int/series"
           "intersect" "iolib" "iquo" "irem" "is_gmp" "isqrt"
           "kernel/transpose" "kernelopts" "lcoeff" "ldegree" "length"
           "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm"
           "member" "min" "minus" "mod" "modp" "modp1" "modp2" "mods" "mul"
           "mvMultiply" "negate" "nops" "normal" "not" "numboccur" "numer"
           "op" "or" "order" "ormap" "overload" "parse" "piecewise" "pointto"
           "print" "quit" "readlib" "reduce_opr" "remove" "rhs" "rtable"
           "rtableInfo" "rtable_convolution" "rtable_eval" "rtable_histogram"
           "rtable_indfns" "rtable_is_zero" "rtable_normalize_index"
           "rtable_num_dims" "rtable_num_elems" "rtable_options" "rtable_redim"
           "rtable_scale" "rtable_scanblock" "rtable_sort_indices" "rtable_zip"
           "savelib" "searchtext" "select" "selectremove" "seq" "series"
           "setattribute" "sign" "sort" "ssystem" "stop" "streamcall" "subs"
           "subset" "subsop" "substring" "system" "table" "taylor" "tcoeff"
           "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames"
           "unbind" "union" "userinfo" "writeto" "xor" "`{}`" "`||`"))
    "Alist of Maple builtin funtions.  The key is the major release."))

(defun maplev--ditto-operators-re ()
  "Return a regexp that matches the ditto operators."
  (regexp-opt
   (if (< (maplev--major-release) 5)
       '("\"" "\"\"" "\"\"\"")
     '("%" "%%" "%%%"))))

(defun maplev-font-lock-keywords-1 ()
  "Compute the minimum decoration `font-lock-keywords' for MapleV mode.
Top level procedures, Maple reserved words, and preprocessor directives
are font locked."
  (list
   (list maplev--top-defun-begin-re '(1 font-lock-function-name-face t))
   (list maplev--preprocessor-directives-re '(0 maplev-preprocessor-face))
   (list (maplev--list-to-word-re
          (cdr (assoc (maplev--major-release)
                      maplev--reserved-words-alist)))
         '(0 font-lock-keyword-face))))


(defun maplev-font-lock-keywords-2 ()
  "Compute the medium decoration `font-lock-keywords' for MapleV mode.
Add special words, initial variables, and the ditto operators to the
minimum decoration keywords."
  (append
   (maplev-font-lock-keywords-1)
   (list
    (list maplev--special-words-re     '(0 font-lock-variable-name-face))
    (list maplev--initial-variables-re '(0 font-lock-reference-face))
    (list (maplev--ditto-operators-re) '(0 font-lock-variable-name-face)))))

(defun maplev-font-lock-keywords-3 ()
  "Compute the maximum decoration `font-lock-keywords' for MapleV mode.
Add builtin functions to the medium decoration keywords."
  (let ((max-specpdl-size 10000))       ; default 600 is too small
    (append (maplev-font-lock-keywords-2)
            (list (list (maplev--list-to-word-re
                         (cdr (assoc (maplev--major-release)
                                     maplev--builtin-functions-alist)))
                        ;; Xemacs doesn't have font-lock-builtin-face
                        '(0 font-lock-variable-name-face))))))
(defun maplev--font-lock-keywords ()
  "Return a list of symbols for font locking MapleV mode buffers."
  '(maplev-font-lock-keywords-3        ; default is maximum decoration
    maplev-font-lock-keywords-1
    maplev-font-lock-keywords-2
    maplev-font-lock-keywords-3))

(defun maplev--font-lock-syntax-alist ()
  "Return the syntax alist appropriate for font lock.
It depends on `maplev--major-release'."
  `((?_ . "w")                          ; make `_' a word character
    ,(if (< (maplev--major-release) 5)
         '(?\" . "w")     ; make `"' a word character for R4 and down.
       '(?% . "w"))))       ; make `%' a word character for R5 and up.

(defun maplev--syntax-begin ()
  "Move backwards to start of a Maple procedure.
This is passed to `font-lock-defaults' as the SYNTAX-BEGIN argument."
  (re-search-backward maplev--top-defun-begin-re nil 'move))

(defun maplev-reset-font-lock (&optional decoration)
  "Reset the font lock patterns for MapleV mode.  Fontify the buffer.
The optional argument DECORATION selects the level of font lock.
If nil then `font-lock-maximum-decoration' selects the level."
  (interactive (list (completing-read "Decoration (1-3): "
                                      '(("1") ("2") ("3"))
                                      nil t)))
  (if decoration
      (setq font-lock-maximum-decoration decoration))
  (setq font-lock-defaults `(,(maplev--font-lock-keywords)
                             nil nil
                             ,(maplev--font-lock-syntax-alist)
                             maplev--syntax-begin))
  (font-lock-set-defaults)
  (font-lock-fontify-buffer))

;;}}}
;;{{{ Tags

;; I'm not sure about how tags should work.  Should it run on all
;; Maple files in the directory?  Running it on just one file makes
;; little sense.  The tags could be appended, but then the TAGS file
;; will have lots of redunancy following multiple executions.

;; (defcustom maplev-etags "etags"
;;   "Etag program."
;;   :type 'string
;;   :group 'maplev)

;; (defcustom maplev-tag-regexp
;;   (concat "'/\\([^# \t]+\\)[ \t]*:=[ \t]*proc(/\\1/'")
;;   "Regular expression used by etag."
;;   :type 'string
;;   :group 'maplev)

;; ;; where does the following store the tag table?
;; ;; Always in the same directory as the

;; (defun maplev-tag-file ()
;;   "Create a tags table for the existing buffer/file."
;;   (interactive)
;;   (shell-command
;;    (concat maplev-etags
;;         " --language=none --regex="
;;         maplev-tag-regexp
;;         " "
;;         (buffer-file-name))))

;;}}}

;;; Process Modes

;;{{{ Group definitions

(defgroup maplev-buffer nil
  "Maple buffer stuff \(mostly names\)."
  :group 'maplev)

(defgroup maplev-help nil
  "Maple help pages."
  :group 'maplev)

(defgroup maplev-mint nil
  "Mint setup."
  :group 'maplev
  :group 'maplev-executables)

;;}}}
;;{{{ Customizable variables

;;{{{   buffers

(defcustom maplev-pop-up-frames-flag nil
  "*Non-nil means help pages and procedure listings start in a separate frame."
  :type 'boolean
  :group 'maplev-misc)

(defcustom maplev-cmaple-end-notice "END_OF_OUTPUT"
  "*Message used to indicate the end of Maple output."
  :type 'string
  :group 'maplev-misc)

(defcustom maplev-cmaple-echoes-flag
  (not (string-match "windows-nt\\|ms-dos" (symbol-name system-type)))
  "*Non-nil means the process echoes."
  :type 'boolean
  :group 'maplev-buffer
  :group 'maplev-important)

;;}}}
;;{{{   maple setup
(defcustom maplev-start-options (list "-q")
  "*List of Maple command line options.  Each item is a string."
  :type 'list
  :group 'maplev-executables)

(defcustom maplev-startup-directory nil
  "If non-nil, change to this directory before running Maple.
Otherwise use the default directory of `maplev-cmaple-buffer'."
  :type '(choice string (const :tag "default" nil))
  :group 'maplev-executables)

(defcustom maplev-cmaple-prompt "> "
  "String inserted as prompt in Maple buffer."
  :type 'string
  :group 'maplev-executables
  :group 'maplev-buffer)
;;}}}

;;}}}
;;{{{ Internal variables

(defvar maplev--history-stack nil
  "Stack variable used for the history mechanism.
It is local to the `maplev-help-mode' and `maplev-proc-mode' buffers.")

(defvar maplev--process-item nil
  "The name of a function that processes items on `maplev--history-stack'.
It is local to the `maplev-help-mode' and `maplev-proc-mode' buffers.")

;;}}}
;;{{{ Release

(defun maplev--help-buffer ()
  "Return the name of the Maple help buffer."
  (concat "Maple R" maplev-release " help"))

(defun maplev--proc-buffer ()
  "Return the name of the Maple procedure listing buffer."
  (concat "Maple R" maplev-release " proc"))

(defun maplev--cmaple-buffer ()
  "Return the name of the Maple cmaple buffer."
  (concat "Maple R" maplev-release))

;;}}}
;;{{{ Maple

;;{{{   comm functions

;; Define the functions used for communicating with the command line
;; Maple process.
;;
;; A useful feature is having independent Maple processes associated
;; with particular (source) buffers.  Doing so will require rewriting
;; the access control, however, it should result in a more robust
;; design.  Is it worth it? 
;;
;; One method to accomplish this is the following:
;;
;;  - Create a (source) buffer-local variable that stores the process.
;;  - Create an (output) buffer-local flag variable that stores the lock status.
;;
;; To check whether the process is locked, make the output buffer the
;; current buffer and check its flag variable.  When a second source
;; buffer (first) requires a Maple process, the user should be queried
;; (dependent on a configuration variation)  whether it should use an
;; existing Maple process, provided it is of the proper release.
;; Independent Maple output buffers should be numbered sequentially.
;;
;; A difficulty, or at least a nusiance, is handling the help and proc
;; modes.  Ideally all source buffers that have the same Maple release
;; would use a common help or proc buffer.  However, because proc may
;; depend on the state of Maple, its buffer must be associated with a
;; specific Maple process.  The straightforward solution is to have a
;; separate help or proc buffer associated with each independent Maple
;; process.  It leads to more buffers than I'd like.  

(defun maplev--cmaple-process ()
  "Return the cmaple process associated with the current buffer.
Start one, if necessary."
  (let ((process (get-buffer-process (maplev--cmaple-buffer))))
    (if (and process (eq (process-status process) 'run))
        process
      (maplev-cmaple--start-process))))


(defun maplev-cmaple--start-process ()
  "Start a cmaple process associated with the current buffer.
Return the process.  If such a process already exists, kill it and
restart it."
  (let* ((release maplev-release)
         (cmaple (nth 0 (cdr (assoc release maplev-executable-alist))))
         (inifile (nth 1 (cdr (assoc release maplev-executable-alist))))
         (buffer (get-buffer-create (maplev--cmaple-buffer)))
         (process (get-buffer-process buffer))
         ;; Just testing this.  Is there an advantage to a PTY process?
         (process-connection-type 'pty)) 
    (with-current-buffer buffer
      (message "Starting Maple R%s..." release)
      (if process (delete-process process))
      (if maplev-startup-directory
          (cd (expand-file-name maplev-startup-directory)))
      (set-process-filter
       ;; `apply' is used because `maplev-start-options' is a list.
       (setq process (apply 'start-process
                            (concat "Maple R" release)
                            buffer
                            cmaple
                            (append (and inifile (list "-i" inifile))
                                    maplev-start-options ;; add include path to argument list
                                    (and maplev-include-path
                                         (list (concat "-I " 
                                                       (mapconcat 'identity maplev-include-path ",")))))))
       'maplev--cmaple-filter)
      (maplev-cmaple-mode release)
      (maplev-cmaple--lock-access t)
      (comint-simple-send process
                          (cdr (assoc release maplev-init-string-alist)))
      (maplev-cmaple--send-end-notice process)
      ;; Wait until cmaple is unlocked, that is, it has responded.
      ;; The time step, 100 milliseconds, should be customizable, some OSs
      ;; do not support fractions of seconds.
      ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
      (maplev-cmaple--wait)
      (message "Maple R%s started" release)
      process)))

;; Access control

;; JR: Are the lines marked "hieida" the original or his suggested
;; correction?  I don't see the point of using a fixed symbol,
;; maplev-release as the property in which to store the lock status.
;; Using the value of maplev-release makes sense.  Alas, I no longer
;; have his email.  A better way to handle this might be to attach the
;; property to a buffer local variable.  However, I don't think that
;; that is possible.  Possibly the correct technique is to create a
;; flag variable that is local to the Maple output buffer and assign
;; to it.

(defun maplev-cmaple--lock-access (&optional no-error)
  "Lock access to cmaple.
If access is already locked, generate an error
unless optional arg NO-ERROR is non-nil."
  (if (and (not no-error) (maplev-cmaple--locked-p))
      (error "Maple busy")
;;hieida:
;;    (put 'maplev-cmaple-state maplev-release 'locked)))
    (put 'maplev-cmaple-state 'maplev-release 'locked)))

(defun maplev-cmaple--unlock-access ()
  "Unlock access to cmaple.
Interactively use \\[maplev-cmaple-interrupt]."
;;hieida:
;;  (put 'maplev-cmaple-state maplev-release nil))
  (put 'maplev-cmaple-state 'maplev-release nil))

(defun maplev-cmaple--locked-p ()
  "Return non-nil if the Maple process is locked."
;;hieida:
;;  (eq (get 'maplev-cmaple-state maplev-release) 'locked))
  (eq (get 'maplev-cmaple-state 'maplev-release) 'locked))

(defun maplev-cmaple-status ()
  "Status of Maple process."
  (interactive)
;;hieida:
;;  (let ((status (get 'maplev-cmaple-state maplev-release)))
  (let ((status (get 'maplev-cmaple-state 'maplev-release)))
    (message "Maple R%s %s" maplev-release
             (cond ((eq status 'locked) "locked")
                   ((not status) "unlocked")
                   (status)))))

(defun maplev-cmaple--wait (&optional max-cnt no-err)
  "Wait for cmaple to become available.  
If optional argument MAX-CNT is non-nil, wait at most that many
seconds; otherwise wait indefinitly.  If optional argument NO-ERR is
nil, generate an error if time out occurs; if non-nil, do not generate
an error."
  (message "Maple busy, waiting...")
  (let ((cnt (* 10 (or max-cnt 0))))
    (while (and (maplev-cmaple--locked-p)
                (or (null max-cnt)
                    (< 0 (setq cnt (1- cnt)))))
      ;; Should sit-for be used instead?  It permits interrupting
      ;; via user input (keystrokes).
      (sleep-for 0.1))
    (and (not no-err)
         (maplev-cmaple--locked-p)
         (error "Maple busy."))))

;; Functions that send stuff to cmaple

(defun maplev-cmaple-send ()
  "Send input to Maple."
  (interactive)
  (let ((pmark (process-mark (maplev--cmaple-process)))
        (maplev-mint-info-level maplev-mint-error-level)
        (comint-input-sender (function maplev-cmaple--send-string)))
    ;; Only _new_ input is checked for typos, see comint-send-input.
    ;; We might need something smarter for comint-get-old-input.
    ;; Why does comint-send-input use (line-end-position) instead of
    ;; (point-max)?  To be consistent maplev-mint-region does the same.
    (if (or (< (point) (marker-position pmark))
            (equal 0 (maplev-mint-region pmark (line-end-position))))
        (comint-send-input))))

(defun maplev-cmaple--send-string (process string)
  "Send STRING to the cmaple process PROCESS."
  ;; handle Maple `restart' by adding the initialization according to
  ;; maplev-init-string-alist
  (let ((str "") case-fold-search)
    (while (string-match "\\ (length string) (match-end 0))
                       (substring string (match-end 0))
                     "")))
    (setq string (concat str string)))
  (maplev-cmaple--lock-access)
  (set-process-filter process 'maplev--cmaple-filter)
  (comint-simple-send process string)
  (maplev-cmaple--send-end-notice process))

(defun maplev-cmaple-send-region (beg end)
  "Send the region from BEG to END to cmaple.
If called interactively use the marked region.
If called with a prefix the cmaple buffer is first cleared."
  (interactive "r")
  (let ((maplev-mint-info-level maplev-mint-error-level)) ;; TODO: Change to -S for syntax only!
    (when (equal 0 (maplev-mint-region beg end))
      (and current-prefix-arg (maplev-cmaple--clear-buffer))
      (maplev-cmaple--send-string (maplev--cmaple-process)
                                  (buffer-substring-no-properties beg end)))))

(defun maplev-cmaple-send-line ()
  "Send the current line to cmaple"
  (interactive)
  (maplev-cmaple-send-region (line-beginning-position) (line-end-position)))

(defun maplev-cmaple-send-buffer ()
  "Send the buffer to cmaple."
  (interactive)
  (maplev-cmaple-send-region (point-min) (point-max)))

(defun maplev-cmaple-send-procedure ()
  "Send the current procedure to cmaple."
  (interactive)
  (apply 'maplev-cmaple-send-region (maplev-current-defun)))

(defun maplev-cmaple-direct (input &optional delete)
  "Send the string INPUT to cmaple and return the output.
If optional argument DELETE is non-nil, delete the echoed Maple input
from the output buffer.  This is a very simple function, it assumes
that the input consists of one line and the output is on the following line."
  ;; This may not work on a Windows box; there, the input is not echoed
  ;; to the output buffer.
  (interactive)
  ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
  (maplev-cmaple--wait)
  (save-current-buffer
    (let ((proc (maplev--cmaple-process))) ; ensure Maple is started
      (set-buffer (maplev--cmaple-buffer))
      (save-restriction
        (narrow-to-region (point-max) (point-max))
        (maplev-cmaple--send-string proc input)
        ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
        (maplev-cmaple--wait)
        (goto-char (point-min))
        (forward-line)
        (let ((output (buffer-substring-no-properties
                       (line-beginning-position) (line-end-position))))
          (if delete
              (delete-region (point-min) (point-max)))
          output)))))
      
(defun maplev-cmaple--send-end-notice (process)
  "Send a command to PROCESS \(cmaple\) to print `maplev-cmaple-end-notice'."
  (comint-simple-send process (concat "lprint(" maplev-cmaple-end-notice ");")))

(defun maplev-cmaple--ready (process)
  "Return t if PROCESS \(cmaple\) ready for new input, nil otherwise.
Remove `maplev-cmaple-end-notice' from the current buffer.
Reset the filter for PROCESS \(cmaple\) and unlock access."
  (let (case-fold-search)
    (save-excursion
      (when (re-search-backward
             (concat maplev-cmaple-end-notice "\n") nil t)
        (delete-region (match-beginning 0) (match-end 0))
        (when (and maplev-cmaple-echoes-flag
                   (re-search-backward
                    (concat "lprint(" maplev-cmaple-end-notice ");\n")
                    nil t))
          (delete-region (match-beginning 0) (match-end 0)))
        (maplev--cleanup-buffer)
        (set-process-filter process 'maplev--cmaple-filter)
        (maplev-cmaple--unlock-access)
        t))))

(defun maplev-cmaple-interrupt ()
  "Interrupt Maple."
  (interactive)
  (let ((process (get-buffer-process (maplev--cmaple-buffer))))
    (message "Interrupt process %s" (process-name process))
    (interrupt-process process)
    (maplev-cmaple--unlock-access)))

(defun maplev-cmaple-kill ()
  "Kill Maple."
  (interactive)
  (let ((process (get-buffer-process (maplev--cmaple-buffer))))
    (message "Kill process %s" (process-name process))
    (kill-process process)))

(defun maplev-cmaple--clear-buffer ()
  "Clear the contents of the cmaple buffer."
  (save-excursion
    (set-buffer (maplev--cmaple-buffer))
    (delete-region (point-min) (point-max))))
                 

(defun maplev-cmaple-pop-to-buffer (&optional release)
  "Pop up a buffer with command line Maple.  Start Maple, if necessary.
Optional arg RELEASE defaults to `maplev-release'."
  (interactive
   (list (if current-prefix-arg
             (completing-read "Maple release: "
                              (mapcar (lambda (item) (list (car item)))
                                      maplev-executable-alist)
                              nil t))))
  (unless release (setq release maplev-release))
  (let ((maplev-release release))
    (maplev--cmaple-process)
    (pop-to-buffer (maplev--cmaple-buffer))
    (goto-char (point-max))))

(defalias 'cmaple 'maplev-cmaple-pop-to-buffer)

(defun maplev--cmaple-filter (process string)
  "Send the Maple output to the Maple buffer.
PROCESS is the Maple process, STRING its output."
  (with-current-buffer (process-buffer process)
    (let ((pmark (process-mark process)))
      (save-excursion
        (save-restriction
          (goto-char pmark)
          (narrow-to-region (point) (point))
          (insert string)
          (maplev--cleanup-buffer)
          (goto-char (point-max))
          (set-marker pmark (point)))
        (when (maplev-cmaple--ready process)
          (insert maplev-cmaple-prompt)
          (set-marker pmark (point))))
      (goto-char pmark))))

(defun maplev--cleanup-buffer ()
  "Remove overstriking and underlining from the current buffer."
  (goto-char (point-min))
  (while (re-search-forward "\e\\[[0-9;]+m" nil t) (replace-match ""))
  (goto-char (point-min))
  (while (re-search-forward "\r+" nil t) (replace-match "\n")))

;;}}}
;;{{{   mode map

(defvar maplev-cmaple-map nil
  "Keymap used in Maple cmaple mode.")

(unless maplev-cmaple-map
  (let ((map (copy-keymap comint-mode-map)))
    (define-key map [(return)]                'maplev-cmaple-send)
    (define-key map [(control c) (control c)] 'maplev-cmaple-interrupt)
    (define-key map [?\?]                     'maplev-help-at-point)
    (define-key map [(control ?\?)]           'maplev-help-at-point)
    (define-key map [(meta ?\?)]              'maplev-proc-at-point)
    (define-key map [(meta tab)]              'maplev-complete-symbol)
    (define-key map [(control a)]             'comint-bol)

    ;; These two bindings are needed only under linux / unix
    (define-key map [(meta control y)]    'maplev-insert-cut-buffer)

    ;; mouse button bindings
    (define-key map (maplev--mouse-keymap '(control meta 2))  'maplev-mouse-yank-cut-buffer)
    (define-key map (maplev--mouse-keymap '(shift 2))         'maplev-help-follow-mouse)
    (define-key map (maplev--mouse-keymap '(control shift 2)) 'maplev-help-follow-mouse)
    (define-key map (maplev--mouse-keymap '(meta shift 2))    'maplev-proc-follow-mouse)

    ;; in comint-mode-map of emacs 21, `C-c C-s' is bound to comint-write-output.
    ;; Remove it so that it can be used as a prefix key to switch buffers.
    (define-key map [(control c) (control s)]     nil)
    (define-key map [(control c) (control s) ?h] 'maplev-switch-buffer-help)
    (define-key map [(control c) (control s) ?l] 'maplev-switch-buffer-proc)
    (define-key map [(shift return)]             'newline)
    (setq maplev-cmaple-map map)))

;;}}}
;;{{{   mode

(defconst maplev-input-line-keyword
  `((,(concat "^" maplev-cmaple-prompt ".*$") . maplev-input-face))
  "Keyword for font locking input lines in cmaple mode.")

(defun maplev-cmaple-mode (&optional release)
  "Major mode for interacting with cmaple.
RELEASE is the release of Maple that should be started, if nil the
`maplev-default-release' is used.  It has the same commands as
`comint-mode' plus some additional commands for interacting with
cmaple.

\\{maplev-cmaple-map}"
  (interactive)
  (comint-mode)
  (setq comint-prompt-regexp (concat "^\\(" maplev-cmaple-prompt "\\)+ *")
        ;; GNU Emacs 21
        comint-use-prompt-regexp-instead-of-fields t
        comint-eol-on-send t
        major-mode 'maplev-cmaple-mode
        mode-name "Maple")

  ;; Mint support
  (make-local-variable 'maplev-mint--code-beginning)
  (make-local-variable 'maplev-mint--code-end)

  (maplev-set-release release)
  (use-local-map maplev-cmaple-map)
  (set (make-local-variable 'font-lock-defaults)
       '(maplev-input-line-keyword))
  (set (make-local-variable 'comint-process-echoes)
       maplev-cmaple-echoes-flag)
  (make-local-variable 'maplev-cmaple-prompt)
  (font-lock-mode 1)
  (run-hooks 'maplev-cmaple-mode-hook))

;;}}}

;;}}}

;;{{{ Help mode

;;{{{   mode map

(defvar maplev-help-mode-map nil
  "Keymap used in `maplev-help-mode'.")

(unless maplev-help-mode-map
  (let ((map (make-sparse-keymap)))
;;    (define-key map [(SPC)]                      'scroll-up)
    (define-key map (read-kbd-macro "SPC")       'scroll-up)
    (define-key map [(backspace)]                'scroll-down)
    (define-key map [?q]                         'quit-window)
    (define-key map [?s]                         'isearch-forward)
    (define-key map [?r]                         'maplev-history-redo-item)
    (define-key map [?p]                         'maplev-history-prev-item)
    (define-key map [?n]                         'maplev-history-next-item)
    (define-key map [?d]                         'maplev-history-delete-item)
    (define-key map [?P]                         'maplev-help-parent)
    (define-key map [?\?]                        'maplev-help-at-point)
    (define-key map [(control ?\?)]              'maplev-help-at-point)
    (define-key map [(meta ?\?)]                 'maplev-proc-at-point)
    (define-key map [?f]                         'maplev-tear-off-window)
    (define-key map [(control c) (control s) ?h] 'maplev-switch-buffer-help)
    (define-key map [(control c) (control s) ?l] 'maplev-switch-buffer-proc)
    (define-key map [(control c) (control s) ?c] 'maplev-switch-buffer-cmaple)
    (define-key map [?h]                         'maplev-switch-buffer-help) ; short-cut
    (define-key map [?l]                         'maplev-switch-buffer-proc) ; short-cut
    (define-key map [?c]                         'maplev-switch-buffer-cmaple) ; short-cut
    (define-key map [(return)]                   'maplev-help-at-point)
    (define-key map [(meta return)]              'maplev-proc-at-point)

    ;; Bind mouse buttons
    (define-key map (maplev--mouse-keymap '(2))               'maplev-help-follow-mouse)
    (define-key map (maplev--mouse-keymap '(shift 2))         'maplev-help-follow-mouse)
    (define-key map (maplev--mouse-keymap '(control shift 2)) 'maplev-help-follow-mouse)

    (define-key map (maplev--mouse-keymap '(meta 2))          'maplev-proc-follow-mouse)
    (define-key map (maplev--mouse-keymap '(meta shift 2))    'maplev-proc-follow-mouse)

    (setq maplev-help-mode-map map)))

(defvar maplev-help-mode-menu nil)
(unless maplev-help-mode-menu
  (easy-menu-define
    maplev-help-mode-menu maplev-help-mode-map
    "Menu for Maple help and proc buffer."
    `("MapleV"
      ["Parent"         maplev-help-parent
       :included (eq major-mode 'maplev-help-mode)]
      ["Previous"       maplev-history-prev-item t]
      ["Next"           maplev-history-next-item t]
      ["Redraw"         maplev-history-redo-item t]
      ["Delete"         maplev-history-delete-item t]
      ["Goto help node" maplev-help-at-point t]
      ["Goto proc node" maplev-proc-at-point t]
      ["Clear history"  maplev-history-clear t]
      "---"
      ["Separate frame" maplev-tear-off-window
       :active (not (one-window-p t 'here))]
      "---"
      ("Decoration" :included (eq major-mode 'maplev-proc-mode)
       ,@maplev--menu-decoration))))

;;}}}
;;{{{   mode definition

(defun maplev-help-mode (&optional release)
  "Major mode for displaying Maple help pages.
RELEASE is the Maple release, if nil, `maplev-default-release' is used.

\\{maplev-help-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'maplev-help-mode) ;; needed by maplev-set-release
  (maplev-set-release release)
  (setq mode-name (concat "Maple-Help R" maplev-release))
  (use-local-map maplev-help-mode-map)
  (set (make-local-variable 'maplev--process-item)
       (function maplev--help-process))

  (make-local-variable 'maplev--history-stack) ; set up the stack
  (maplev-history-clear)

  ;; for maplev--activate-hyperlinks
  (set (make-local-variable 'parse-sexp-lookup-properties) t)

  (maplev-help-fontify-node)
  (setq buffer-read-only t)
  (run-hooks 'maplev-help-mode-hook))

;;}}}
;;{{{   mode functions

(defun maplev-help-follow-mouse (click)
  "Display the Maple help page of the topic at the mouse CLICK."
  (interactive "e")
  (set-buffer (window-buffer (event-window click)))
  (goto-char (event-point click))
  (maplev-help-show-topic (maplev--ident-around-point)))

(defun maplev--ident-around-point (&optional default)
  "Return the identifier around the point as a string.
If it is empty use DEFAULT.
If choice is empty, an error is signaled, unless DEFAULT equals \"\" or t."
  ;; If point is in a string enclosed by backquotes,
  ;; we take the whole string including the backquotes.
  (let* ((state (parse-partial-sexp (maplev-safe-position)
                                    (point)))
         (choice (if (equal ?` (nth 3 state))
                     ;; inside a string
                     (buffer-substring-no-properties
                      (nth 8 state)
                      (save-excursion (goto-char (nth 8 state))
                                      (forward-sexp 1) (point)))
                   (current-word))))
    (if (string-equal choice "")
        (cond ((stringp default)
               default)
              (default "")
              ((error "Empty choice")))
      choice)))

(defun maplev-ident-around-point-interactive (prompt &optional default complete)
  "Request Maple identifier in minibuffer, using PROMPT.
Default is identifier around point. If it is empty use DEFAULT.
Minibuffer completion is used if COMPLETE is non-nil."
  ;; Suppress error message
  (if (not default) (setq default t))
  (let ((enable-recursive-minibuffers t)
        (ident (maplev--ident-around-point default))
        (maplev-completion-release maplev-release)
        choice)
    (setq prompt (concat prompt (unless (string-equal ident "")
                                  (concat " (default " ident ")"))
                         ": ")
          choice (if complete
                     (completing-read prompt 'maplev--completion
                                      nil nil nil maplev-history-list ident)
                   (read-string prompt nil maplev-history-list ident)))
    ;; Are there situations where we want to suppress the error message??
    (if (string-equal choice "")
        (error "Empty choice"))
    (maplev--string-to-name choice)))

(defun maplev--string-to-name (name)
  "Convert NAME to a valid Maple name. Add backquotes if needed."
  ;; Do we need something more general to match a string that might
  ;; require backquotes?
  (when (string-match "/" name)
    (if (not (string= "`" (substring name 0 1)))
        (setq name (concat "`" name)))
    (if (not (string= "`" (substring name -1)))
        (setq name (concat name "`"))))
  name)

(defun maplev-help-at-point (topic)
  "Display Maple help for TOPIC \(a string\).
Interactively, default is word point is on."
  (interactive (list (maplev-ident-around-point-interactive
                      "Maple help topic" "help" t)))
  (maplev-help-show-topic topic))

(defun maplev-help-show-topic (topic &optional hide)
  "Display Maple help for TOPIC \(a string\).
Push TOPIC onto the local stack, unless it is already on the top.
If optional arg HIDE is non-nil do not display buffer."
  (save-current-buffer             ; maybe should be deeper (NEW!!!!!)
    (let ((release maplev-release)) ;; we switch buffers!
      (set-buffer (get-buffer-create (maplev--help-buffer)))
      (unless (eq major-mode 'maplev-help-mode)
        (maplev-help-mode release))
      ;; Push TOPIC onto history stack
      (maplev--history-stack-process topic hide))))

;;(setq maplev-cmaple-screenheight 24)

(defun maplev--help-process (topic)
  "Display Maple help for TOPIC in `maplev--help-buffer'."
  (let ((process (maplev--cmaple-process)))
    ;; TODO this doesn't quite work, it echos in the cmaple buffer
;;    (maplev-cmaple-direct "interface('screenheight'='infinity'):")
    (maplev-cmaple--lock-access)
    (set-process-filter process 'maplev--help-filter)
    (set-buffer (maplev--help-buffer))
    (setq mode-line-buffer-identification (format "%-12s" topic))
    (let (buffer-read-only)
      (delete-region (point-min) (point-max)))
    (comint-simple-send process (concat "?" topic))
    (maplev-cmaple--send-end-notice process)))
;;    ;; TODO this doesn't quite work, it echos in the cmaple buffer
;;     (maplev-cmaple-direct (concat "interface('screenheight'="
;;                                (number-to-string maplev-cmaple-screenheight)
;;                                "):"))))

(defun maplev--help-filter (process string)
  "Pipe the output of a help command into `maplev--help-buffer'.
PROCESS calls this filter.  STRING is the output."
  (with-current-buffer (maplev--help-buffer)
    (save-excursion
      (let (buffer-read-only)
        (save-restriction
          (goto-char (point-max))
          (narrow-to-region (point) (point))
          (insert string)
          (maplev--cleanup-buffer))
        (goto-char (point-max))
        (if (maplev-cmaple--ready process)
            (maplev-help--cleanup-buffer))))))

(defun maplev-help--cleanup-buffer ()
  "Cleanup Maple help pages."
  (if maplev-cmaple-echoes-flag
      (save-excursion
        (goto-char (point-min))
        (if (re-search-forward "\\`\\?.+\n" nil t)
            (delete-region (match-beginning 0) (match-end 0)))))
  (maplev-help-fontify-node)
  (set-buffer-modified-p nil))

(defun maplev-switch-buffer-help ()
  "Switch to help buffer, if it exists."
  (interactive)
  (maplev-switch-buffer (maplev--help-buffer)))

(defun maplev-switch-buffer-proc ()
  "Switch to proc buffer, if it exists."
  (interactive)
  (maplev-switch-buffer (maplev--proc-buffer)))

(defun maplev-switch-buffer-cmaple ()
  "Switch to cmaple buffer, if it exists."
  (interactive)
  (maplev-switch-buffer (maplev--cmaple-buffer)))

(defun maplev-switch-buffer (buffer)
  "Switch to BUFFER, if it exists."
  (let ((buf (get-buffer buffer)))
    (if buf
        (switch-to-buffer buf)
      (message "No buffer \"%s\"." buffer))))

;;}}}
;;{{{   history mechanism

(defun maplev-help-parent ()
  "Display the parent node of the current help page.
The parent node is extracted from the context of the help page, not
from the parent defined in the Maple help system."
  (interactive)
  (goto-char (point-min))
  (if (looking-at "\\(Function: ?\\)?\\([a-zA-Z0-9]*\\)\\[")
      (maplev-help-show-topic (match-string 2))
    (maplev-help-show-topic "index")))

;;}}}
;;{{{   fontify

;;{{{     fonts

(defcustom maplev-help-function-face 'font-lock-function-name-face
  "Face name for functions in title lines of Maple help pages."
  :type 'face
  :group 'maplev-faces
  :group 'maplev-help)

(defvar maplev-help-title-face   'maplev-help-title-face
  "*Face name for subtitles in title lines of Maple help pages.")

(defvar maplev-help-section-face 'maplev-help-section-face
  "*Face name for section titles in Maple help pages.")

(defvar maplev-help-subsection-face 'maplev-help-section-face
  "*Face name for section titles in Maple help pages.")

(defvar maplev-input-face  'maplev-input-face
  "*Face name for Maple input in help pages and Maple buffer.")

(defface maplev-help-title-face
  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
    (((class color)     (background light)) (:foreground "Black"     :bold t))
    (((class color)     (background dark))  (:foreground "Green"     :bold t))
    (t (:bold t)))
  "Font lock mode face used to highlight subtitles in Maple help pages.
The title is the phrase following the function name."
  :group 'maplev-faces
  :group 'maplev-help)

(defface maplev-help-section-face
  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
    (((class color)     (background light)) (:foreground "Red"       :bold t))
    (((class color)     (background dark))  (:foreground "Red"       :bold t))
    (t (:bold t)))
  "Font lock mode face used to highlight section titles in Maple help pages."
  :group 'maplev-faces
  :group 'maplev-help)

(defface maplev-help-subsection-face
  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
    (((class color)     (background light)) (:foreground "orange"    :bold t))
    (((class color)     (background dark))  (:foreground "orange"    :bold t))
    (t (:bold t)))
  "Font lock mode face used to highlight section titles in Maple help pages."
  :group 'maplev-faces
  :group 'maplev-help)

(defface maplev-input-face
  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
    (((class color)     (background light)) (:foreground "dark green"))
    (((class color)     (background dark))  (:foreground "green"))
    (t (:bold t)))
  "Font lock mode face used to highlight Maple input."
  :group 'maplev-faces
  :group 'maplev-help)


;;}}}
;;{{{     regular expressions

;; (defconst maplev--help-section-re
;;   (concat "^[A-Z]"                      ; Must start with a capital.
;;           "\\([^\n]*:\\|\\("            ; If it ends with a colon (and whitespace) it matches.
;;           "\\([a-z]+ ?\\)?"             ; If it consists of no more than three alphabetic words,
;;           "\\([A-Za-z][a-z]* ?\\)?"     ; possibly with capitals, then it matches.
;;           "\\([A-Za-z][a-z]* ?\\)?\\)"
;;           "\\)[ \t]*$")
;;   "Regular expression for sections in a Maple help page.")

(defconst maplev--help-section-re
  (concat "^\\(Calling Sequences?"
          "\\|Parameters"
          "\\|Description"
          "\\|Examples"
          "\\|See Also"
          "\\|References"
          "\\|\\(?:List of \\([][a-zA-Z_]+ \\)?\\(Package\\|Subpackage\\|Module\\) Commands\\)"
          "\\):?")
  "Regular expression for sections in a Maple help page.")

(defconst maplev--help-subsection-re
  (concat "^\\([A-Z][a-z-0-9-]+ ?\\([A-Za-z0-9-][a-z]* ?\\)?"
          "\\([A-Za-z][a-z-]*\\)?:?[ \t]*$"
          "\\)")
  "Regular expression for subsections in a Maple help page.")

(defconst maplev--help-definition-re
  "([ \t\n]*\\(Definition/[^) \t\n]+\\)[ \t\n]*)"
  "Regular expression for dictionary hyperlinks")

;;}}}
;;{{{     functions

(defun maplev-help-fontify-node ()
  "Fontify a Maple help page buffer. Does not use font-lock mode."
  (save-excursion
    (let (buffer-read-only
          (case-fold-search t))
      (if font-lock-mode (font-lock-mode)) ; turn-off font-lock.

      ;; Highlight the title.
      ;; The tricky part is handling multiple titles.

      (goto-char (point-min))
      ;; Move to the end of the title area.  Stop at first section or bullet.
      (if (re-search-forward (concat maplev--help-section-re "\\|^- ")
                             nil 'move)
          ;; Move backward to top of buffer, checking each line.
          (while (= 0 (forward-line -1))
            (if (looking-at "\\(Function:\\)?\\([^-\n]*\\)[ \t]+-[ \t]+\\(.*\\)$") ; regexp for function name(sort of)
                (progn (and (match-beginning 1)
                            (put-text-property (match-beginning 1) (match-end 1)
                                               'face 'maplev-help-section-face))
                       (and (match-beginning 3)
                            (put-text-property (match-beginning 3) (match-end 3)
                                               'face 'maplev-help-title-face))
                       (and (match-beginning 2)
                            (maplev--activate-hyperlinks (match-beginning 2) (match-end 2))))
              (put-text-property (point) (progn (end-of-line) (point))
                                 'face 'maplev-help-title-face)))
        (goto-char (point-min))
        (end-of-line)
        (put-text-property (point-min) (point)
                           'face 'maplev-help-title-face))

      ;; Highlight subsection titles
      (goto-char (point-min))
      (while (re-search-forward maplev--help-subsection-re nil t)
        (put-text-property (match-beginning 0) (match-end 0)
                           'face 'maplev-help-subsection-face))

      ;; Highlight section titles
      (goto-char (point-min))
      (while (re-search-forward maplev--help-section-re nil t)
        (put-text-property (match-beginning 0) (match-end 0)
                           'face 'maplev-help-section-face))

      ;; Highlight functions in a package. This usually works.  It
      ;; searches for `- The functions [arbitrary text] are:' and
      ;; highlights everything from the colon to the next line that
      ;; starts with a character that is not whitespace.
      (goto-char (point-min))
      (when (re-search-forward
             "^- The\\( available\\)? \\(functions\\|routines\\)[^\n]* are\\( the following\\)?: *$"
             nil 'move)
        (maplev--activate-hyperlinks
         (point) (progn (re-search-forward "^[^ \t\n]" nil 'move)
                        (line-end-position -1))))

      ;; Highlight Maple input
      (goto-char (point-min))
      (while (re-search-forward "^> .*$" nil t)
        (put-text-property (match-beginning 0) (match-end 0)
                           'face 'maplev-input-face))


      ;; Activate hyperlinks following "See Also".
      ;; Stop when encountering a blank line.
      (goto-char (point-max))
      (and (re-search-backward "^See Also:?" nil 'move)
           (maplev--activate-hyperlinks 
            (match-end 0) 
            (progn
              (re-search-forward "^[ \t\n]*$" nil 'move)
              (point))))

      ;; Activate hyperlinks following "Multiple matches:".
      (goto-char (point-min))
      (and (re-search-forward "^Multiple matches found:" nil 'move)
           (maplev--activate-hyperlinks (match-end 0) (point-max)))

      ;; Active dictionary hyperlinks
      (goto-char (point-min))
      (while (re-search-forward maplev--help-definition-re nil 'move)
        (let ((beg (match-beginning 1))
              (end (match-end 1)))
          (put-text-property beg end 'mouse-face 'highlight)
          (put-text-property beg end 'face maplev-help-function-face))))))

(defun maplev--activate-hyperlinks (beg end)
  "Font lock and activate Maple keywords in the region from BEG to END."
  (goto-char beg)
  (while (re-search-forward
          (concat  maplev--name-re
                   "\\([,/]" maplev--name-re "\\)*")
          end 'move)
    (let ((beg (match-beginning 0))
          (end (match-end 0)))
      ;; Treat everything between beg and end as word constituents.
      ;; In particular, ignore the syntactic meaning of, e.g., `[',
      ;; `]', and `,'. Thus we can use current-word to pick up
      ;; these Maple keywords.
      (put-text-property beg end 'syntax-table '(2 . nil))
      (put-text-property beg end 'mouse-face 'highlight)
      (put-text-property beg end 'face maplev-help-function-face))))

;;}}}

;;}}}

;;}}}
;;{{{ Proc mode

;;{{{   mode map

;; The mode map for maplev-proc-map is identical to that for
;; maplev-help-mode, with one exception: the parent function is not
;; needed, so its key is redefined to self-insert (which generates an
;; error, as does any other insertion, because the buffer if
;; read-only).

(defvar maplev-proc-mode-map nil
  "Keymap used in `maplev-proc-mode'.")

(unless maplev-proc-mode-map
  (let ((map (copy-keymap maplev-help-mode-map)))
    (define-key map [?P] 'self-insert-command)
    (setq maplev-proc-mode-map map)))

;;}}}
;;{{{   mode definition

(defun maplev-proc-mode (&optional release)
  "Major mode for displaying the source code of Maple procedures.
RELEASE is the Maple release, if nil, `maplev-default-release' is used.

\\{maplev-proc-mode-map}"
  (interactive)
  (kill-all-local-variables)

  (setq major-mode 'maplev-proc-mode) ;; needed by maplev-set-release
  (maplev-set-release release)
  (setq mode-name (concat "Maple-Proc R" maplev-release))
  (use-local-map maplev-proc-mode-map)

  (set (make-local-variable 'maplev--process-item)
       (function maplev--proc-process))

  (make-local-variable 'maplev--history-stack) ; set up the stack
  (maplev-history-clear)

  ;; Mint support
  (make-local-variable 'maplev-mint--code-beginning)
  (make-local-variable 'maplev-mint--code-end)

  ;; font-lock support
  (make-local-variable 'font-lock-defaults)
  (make-local-variable 'font-lock-maximum-decoration)
  (maplev-reset-font-lock)

  (setq buffer-read-only t)
  (run-hooks 'maplev-proc-mode-hook))

;;}}}
;;{{{   functions

;;; Define functions for displaying a Maple procedure from the Maple
;;; library in a buffer.

(defun maplev-proc-follow-mouse (click)
  "Display the Maple procedure at the mouse CLICK."
  (interactive "e")
  (set-buffer (window-buffer (event-window click)))
  (goto-char (event-point click))
  (maplev--proc-show-topic (maplev--ident-around-point)))

(defun maplev-proc-at-point (proc)
  "Display the Maple procedure PROC.
Request procedure name in minibuffer, using identifier at point as default."
  (interactive (list (maplev-ident-around-point-interactive
                      "Maple procedure" nil t)))
  (maplev--proc-show-topic proc))

(defun maplev--proc-show-topic (proc &optional hide)
  "Display the Maple procedure PROC \(a string\).
Push PROC onto the local stack, unless it is already on the top.
If optional arg HIDE is non-nil do not display buffer."
  ;; Do not try to display builtin procedures.
  (if (assoc proc (mapcar 'list
                          (cdr (assoc (maplev--major-release) 
                                      maplev--builtin-functions-alist))))
      (message "Procedure \`%s\' builtin." proc)
    (save-current-buffer
      (let ((release maplev-release)) ;; we switch buffers!
        (set-buffer (get-buffer-create (maplev--proc-buffer)))
        (unless (eq major-mode 'maplev-proc-mode)
          (maplev-proc-mode release))
        (maplev--history-stack-process proc hide)))))

(defun maplev--proc-process (proc)
  "Display the Maple procedure PROC \(a string\) in `maplev--proc-buffer'."
  (let ((process (maplev--cmaple-process)))
    (maplev-cmaple--lock-access)
    (set-process-filter process 'maplev-proc-filter)
    (set-buffer (maplev--proc-buffer))
    (setq mode-line-buffer-identification (format "%-12s" proc))
    (let (buffer-read-only)
      (delete-region (point-min) (point-max))
      (goto-char (point-min))
      ;;(insert proc " := ")
      )
    (comint-simple-send process (concat "maplev_print(" proc ");"))
    (maplev-cmaple--send-end-notice process)))

(defun maplev-proc-filter (process string)
  "Pipe a Maple procedure listing into `maplev--proc-buffer'.
PROCESS calls this filter.  STRING is the Maple procedure."
  (with-current-buffer (maplev--proc-buffer)
    (save-excursion
      (let (buffer-read-only)
        (save-restriction
          (goto-char (point-max))
          (narrow-to-region (point) (point))
          (insert string)
          (maplev--cleanup-buffer))
        (goto-char (point-max))
        (if (maplev-cmaple--ready process)
            (maplev-proc-cleanup-buffer))))))

(defun maplev-proc-cleanup-buffer ()
  "Cleanup Maple procedure listings."
  (save-excursion
    (when maplev-cmaple-echoes-flag
      (goto-char (point-min))
      (if (re-search-forward "maplev_print(.+);\n" nil t)
          (delete-region (match-beginning 0) (match-end 0))))
    ;; Delete multiple spaces.
    (goto-char (point-min))
    (while (re-search-forward "[ \t][ \t]+" nil t)
      (replace-match " "))
    ;; terminate with `;'
    (goto-char (point-max))
    (skip-chars-backward " \t\n")
;;    (insert ";")
    )
  (maplev-indent-buffer)
  (set-buffer-modified-p nil)
  (font-lock-fontify-buffer))

;;}}}

;;}}}
;;{{{ Mint mode

;;{{{   customizable variables

(defcustom maplev-mint-coding-system 'undecided-dos
  "*Coding system used by Mint.  See `coding-system-for-read' for details."
  :type '(choice (const undecided-dos) (const raw-text-unix) (symbol :tag "other"))
  :group 'maplev-mint)

(defcustom maplev-mint-query t
  "*Non-nil means query before correcting."
  :type 'boolean
  :group 'maplev-mint)

(defcustom maplev-mint-process-all-vars nil
  "*Non-nil means process all variables in one step."
  :type 'boolean
  :group 'maplev-mint)

(defcustom maplev-mint-include-dir nil
  "*Directory of mint include files.
This should probably be a list of directories."
  :type 'string
  :group 'maplev-mint)
  

;;}}}
;;{{{   syntax table

(defvar maplev-mint-mode-syntax-table nil
  "Syntax table used in Maple mint buffer.")
(unless maplev-mint-mode-syntax-table
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?[  "w"  table)
                         (modify-syntax-entry ?]  "w"  table)
    (modify-syntax-entry ?_  "w"  table)
    (modify-syntax-entry ?/  "w"  table)
    (modify-syntax-entry ?\` "\"" table) ; string quotes
    (setq maplev-mint-mode-syntax-table table)))

;;}}}
;;{{{   mode map

(defvar maplev-mint-mode-map nil
  "Keymap used in Mint mode.")

(unless maplev-mint-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [(space)]                     'scroll-up)
    (define-key map [(backspace)]                 'scroll-down)
    (define-key map [(return)]                    'maplev-mint-rerun)
    (define-key map [(control c) (return) return] 'maplev-mint-rerun)
    (define-key map [?q]                          'quit-window)
    (define-key map [?s]                          'isearch-forward)
    (define-key map [?r]                          'isearch-backward)
    (define-key map (maplev--mouse-keymap '(2))   'maplev-mint-click)
    
    (define-key map [(control c) (control c)]     'maplev-mint-handler)
    (setq maplev-mint-mode-map map)))

;;}}}
;;{{{   menu

(easy-menu-define maplev-mint-mode-menu maplev-mint-mode-map
  "Menu for Mint buffer."
  '("Mint"
    ["Fix errors" maplev-mint-fix-errors :visible nil] ; not yet defined
    ["Rerun mint" maplev-mint-rerun t]
    ["Quit"       quit-window t]))

;;}}}
;;{{{   mode definition

(defun maplev-mint-mode (code-buffer)
  "Major mode for displaying Mint output.
CODE-BUFFER is the buffer that contains the source code.
\\{maplev-mint-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map maplev-mint-mode-map)
  (setq major-mode 'maplev-mint-mode
        mode-name "Mint")
  (set-syntax-table maplev-mint-mode-syntax-table)
  (set (make-local-variable 'maplev-mint--code-buffer) code-buffer)
  (maplev-mint-fontify-buffer)
  (setq buffer-read-only t)
  (run-hooks 'maplev-mint-mode-hook))

;;}}}
;;{{{   mode functions

(defun maplev-mint--goto-source-pos (l c &optional file)
  "Move to position in source file and return position.
If FILE is nil, use buffer `maplev-mint--code-buffer'.
Pop up the buffer, move to either `point-min', if FILE is non-nil,
or `maplev-mint--code-beginning' otherwise,
and move forward L lines and C columns."
  (pop-to-buffer (if file (find-file-noselect file)
                   maplev-mint--code-buffer))
  (goto-char (if file (point-min)  maplev-mint--code-beginning))
  (if (> l 0) (forward-line l))
  (forward-char c)
  (point))

(defun maplev-mint--goto-error (pos)
  "Go to error in Maple source according to Mint message at position POS.
Return position of error in Maple source."
  (let (line col)
    (save-excursion
      (goto-char pos)
      ;; The location of the error is indicated by the caret
      ;; in the Mint output.
      (when (re-search-backward "\\^" (line-beginning-position) t)
        (setq col (current-column))
        (forward-line -1)
        (re-search-forward  "[0-9]+")
        (setq line (1- (string-to-number (match-string 0)))
              col  (- col (current-column) 2))))
    (maplev-mint--goto-source-pos line col)))

(defun maplev-mint--goto-source-proc-old (pos)
  "According to Mint buffer position POS, move point to the end of the
initial assignment statement of a source procedure/module.  This would
be either the closing parenthesis of the formal parameter list, or the
terminating semicolon or colon of an optional procedure/module type
declaration.  Return non-nil if this is a procedure, nil if an operator.

THIS NEEDS WORK TO HANDLE OPERATORS."
  ;; This function uses a fairly complicated regexp in an attempt to
  ;; match the appropriate procedure assignment.  In one sense this is
  ;; overkill; Mint indicates the line number of the start of the
  ;; procedure, so we should be able to go directly to the procedure on
  ;; that line.  It is possible, however, to have a nested procedure on
  ;; the same line as another procedure.  More to the point, a nested
  ;; anonymous procedure inside an anonymous procedure. In that case the
  ;; only distinction is the argument list.  Does this happen enough to
  ;; justify this code?   If we merely desire to move point to the
  ;; correct place in the source, getting to the right line is
  ;; sufficient.  But if there is some automated work to do, the exact
  ;; point is required.  One way to avoid this complexity is to not
  ;; offer the user the option of automatically adding or deleting
  ;; variables from an anonymous procedure.  The sticking point is that
  ;; Mint, alas, considers indexed names to be anonymous procedures so
  ;; their frequency is greater than should be.

  (let (name-re args-re line case-fold-search)
    (save-excursion
      (goto-char pos)
      (re-search-backward "^\\(Nested \\)?\\(Anonymous \\)?\\(Procedure\\|Operator\\|Module\\)")
      ;; Assign name-re the procedure/module name.
      (setq name-re (if (nth 4 (match-data)) ; t if anonymous procedure
                        ""
                      (save-excursion
                        ;; Use `(' to terminate proc-name
                        ;; (re-search-forward "\\(Procedure\\|Module\\)[ \t]*\\([^(]*\\)")
                        (re-search-forward "\\(Procedure\\|Module\\)\\s-*\\([^[(]*\\)")
                        (concat "`?" (match-string-no-properties 2)
                                "\\([ \t\f\n]*\\[[^]]*\\]\\)*" ; optional indices
                                "[ \t\n]*:=[ \t\n]*")))
            ;; Assign a regular expression that matches the argument
            ;; list in the source. The generated regexp does not
            ;; match an argument list with duplicate arguments; this
            ;; because Mint does not print the duplicate arguments.
            ;; This can be improved, made more robust.
            ;; Allow comments before commas, too.
            args-re (save-excursion
                      (re-search-forward "(\\([^)]*\\))")
                      (maplev--replace-string
                       (match-string-no-properties 1)
                       `(("::" . " :: ")
                         ("[ \t\n]+" . "[ \t\n]*")
                         ("," . ,(concat "\\([ \t]*\\(#.*\\)?\n\\)*[ \t]*"
                                         ","
                                         "\\([ \t]*\\(#.*\\)?\n\\)*[ \t]*")))))
            ;; Assign a regular expression that matches any argument
            ;; list.  This may be tougher than I envisioned.  How are
            ;; optional type declarations handled?  The difficulty is
            ;; that they could have commas and closing parentheses.
            
            ;;            args-re (concat "\\s-*\\<\\w+\\>\\(\\s-*::\\s-*[^
            )
      (re-search-forward "on\\s-*lines?\\s-*\\([0-9]+\\)")
      (setq line (1- (string-to-number (match-string 1)))))
    
    ;; move point in source to beginning of line where procedure/module assignment begins.

    (maplev-mint--goto-source-pos line 0)

    ;; move forward to end of assignment.

    (unless (re-search-forward (concat name-re
                                       "\\(proc\\|module\\)[ \t\n*]*"
                                       "(\\([ \t]*\\(#.*\\)?\n\\)*"
                                       args-re
                                       "\\([ \t\n]*#.*$\\)*[ \t\n]*)"
                                       "\\(\\s-*::\\s-*\\<\\w+\\>\\s-*[;:]\\)?" ; optional procedure type
                                       )
                               nil t)
      ;; If search failed (possibly because of duplicate arguments,
      ;; try again without explicitly specifying the argument list.
      (goto-char (maplev--scan-lists 1)))))



(defun maplev-mint--goto-source-proc (pos)
  "According to Mint buffer position POS, move point to the end of the
initial assignment statement of a source procedure/module.  This would
be either the closing parenthesis of the formal parameter list, or the
terminating semicolon or colon of an optional procedure/module type
declaration.  Return non-nil if this is a procedure, nil if an operator."

  ;; find the line number of the source buffer at which the defun starts
  (goto-char pos)
  (re-search-backward "^\\(Nested \\)?\\(Anonymous \\)?\\(Procedure\\|Operator\\|Module\\)")
  (re-search-forward "on\\s-*lines?\\s-*\\([0-9]+\\)")
  ;; move point to the beginning of that line in the source
  (maplev-mint--goto-source-pos 
   (1- (string-to-number (match-string 1)))
   0
   ;; Optional file name, if applicable.
   ;; If looking at something like " to 123 in filename", then
   ;; the source is in filename, which is relative to the
   ;; mint includedir.  Search for that file, using first the current
   ;; directory, then maplev-mint-include-dir.
   (when (looking-at "\\s-+to\\s-+\\(?:[0-9]+\\)\\s-+of\\s-+\\(.*\\)$")
     (let* ((base (match-string 1))
            (file (if (file-exists-p base) 
                      base
                    (concat (file-name-as-directory maplev-mint-include-dir) base))))
       (if (not (file-readable-p file))
           (error (concat "File " file " does not exist or is unreadable"))
         file))))
  ;; move to the end of the defun opening statement
  (re-search-forward ":=")
  (goto-char (maplev--scan-lists 1))
  (if (looking-at "\\s-*::[^;:]+[;:]") (goto-char (match-end 0))))

(defun maplev-mint--goto-source-line (pos)
  "Find the line number in the Mint buffer at position POS, then move
point to that line in the source buffer."
  (goto-char pos)
  (beginning-of-line)
  (re-search-forward "line \\([0-9]+\\)" (line-end-position))
  (maplev-mint--goto-source-pos (1- (string-to-number (match-string 1))) 0))


(defun maplev--replace-string (string replace)
  "In STRING replace as specified by REPLACE.
REPLACE is an alist with elements \(OLD . NEW\)."
  (while replace
    (let ((pos 0)
          (old (caar replace))
          (new (cdar replace)))
      (while (and (< pos (length string))
                  (setq pos (string-match old string pos)))
        (setq string (replace-match new t t string)
              pos (+ pos (length new)))))
    (setq replace (cdr replace)))
  string)

;;}}}
;;{{{   fontify

(defcustom maplev-mint-proc-face 'font-lock-function-name-face
  "Face name for procedure names in a Mint buffer."
  :type 'face
  :group 'maplev-faces
  :group 'maplev-mint)

(defcustom maplev-mint-warning-face 'font-lock-warning-face
  "Face name for warnings in a Mint buffer."
  :type 'face
  :group 'maplev-faces
  :group 'maplev-mint)

(defcustom maplev-mint-error-face 'font-lock-warning-face
  "Face name for error messages in a Mint buffer."
  :type 'face
  :group 'maplev-faces
  :group 'maplev-mint)

(defcustom maplev-mint-note-face 'font-lock-warning-face
  "Face name for notes in a Mint buffer."
  :type 'face
  :group 'maplev-faces
  :group 'maplev-mint)

(defconst maplev-mint-variables-re
  "[ \t\n]*\\(\\(.*,[ \t]*\n\\)*.*\\)[ \t]*$"
  "Regexp used to match the argument list of procedures in Mint output.")

(defconst maplev-mint-fontify-alist
  '(("\\(^on line[ \t]*[0-9]+:\\)" maplev-mint-note-face)
    ("^[ \t]*\\(\\^.*$\\)" maplev-mint-error-face 'error)
    ("^\\(?:Nested \\)?\\(?:Procedure\\|Operator\\|Module\\)[ ]*\\([^(]*\\)" maplev-mint-proc-face 'proc)
    ("^\\(?:Nested \\)?Anonymous \\(?:Procedure\\|Operator\\)[ ]*\\(proc([^)]*)\\)" maplev-mint-proc-face 'proc)
    ("These parameters were never used\\(?: explicitly\\)?:" maplev-mint-warning-face 'unused-arg t)
    ("These names appeared more than once in the parameter list:" maplev-mint-warning-face 'repeat-arg t)
    ("These local variables were not declared explicitly:" maplev-mint-warning-face 'undecl-local t)
    ("These local variables were never used:" maplev-mint-warning-face 'unused-local t)
    ("These names were declared more than once as a local variable:" maplev-mint-warning-face 'repeat-local t)
    ("These names were used as global names but were not declared:" maplev-mint-warning-face 'undecl-global t)
    ("\\(on line [0-9]+\\)" maplev-mint-note-face 'goto-line)
    ;; Could we make the following optional?
    ;; ("Global names used in this procedure:"
    ;;  1 maplev-mint-warning-face 'undecl-global t)
    )
  "Alist for fontification in a Mint buffer. Each element is a list of
the form \(REGEXP FACE PROP VAR\), where REGEXP is to be matched and
FACE is a face.  Optional third element PROP is a symbol used for
marking the category of SUBEXP.  Optional fourth element VAR is
non-nil if REGEXP is concatenated with `maplev-mint-variables-re'.")

(defun maplev-mint-fontify-buffer ()
  "Fontify the mint buffer. Does not use font-lock mode."
  (let ((mlist maplev-mint-fontify-alist)
        regexp mel buffer-read-only case-fold-search)
    (if font-lock-mode (font-lock-mode)) ; turn-off font-lock
    ;; Process elements of maplev-mint-fontify-alist
    (while (setq mel (car mlist))
      (goto-char (point-min))
      (setq regexp (concat (nth 0 mel)
                           (if (nth 3 mel) maplev-mint-variables-re)))
      (while (re-search-forward regexp nil t)
        (let ((beg (match-beginning 1))
              (end (match-end 1)))
          ;; Here we are working with variables whose values are symbols
          ;; with a face property.
          (put-text-property beg end 'face (eval (nth 1 mel)))
          (when (nth 2 mel)
            ;; We use a text property `maplev-mint' to store in the text
            ;; what kind of info we have from Mint.
            (put-text-property beg end 'maplev-mint (eval (nth 2 mel)))
            (if (and (nth 3 mel)
                     (not maplev-mint-process-all-vars)) ; then we do highlighting word-wise
                (save-excursion
                  (goto-char beg)
                  ;; Slightly simpler algorithm than the one used by
                  ;; maplev--ident-around-point to pick up the word
                  ;; where point is. Does it matter for highlighting?
                  ;;                   (while (re-search-forward "\\<\\w+\\>" end t)
                  ;;                     (put-text-property (match-beginning 0) (match-end 0)
                  ;;                                        'mouse-face 'highlight)))
                  (while (re-search-forward "\\<\\(\\w+\\)\\>" end t)
                    (put-text-property (match-beginning 1) (match-end 1)
                                       'mouse-face 'highlight)))
              (put-text-property beg end 'mouse-face 'highlight)))))
      (setq mlist (cdr mlist)))
    (set-buffer-modified-p nil)))

;;}}}
;;{{{   interactive functions

(defun maplev-mint-click (click)
  "Move point to CLICK."
  (interactive "e")
  (set-buffer (window-buffer (event-window click)))
  (maplev-mint-handler (event-point click)))

(defun maplev-mint-handler (pos)
  "Handle mint output at position POS.
When called interactively, POS is position where point is."
  (interactive "d")
  (let ((prop (get-text-property pos 'maplev-mint)))
    (if prop
        (let (string vars)
          (if maplev-mint-process-all-vars
              (let ((str (buffer-substring-no-properties
                          (next-single-property-change pos 'maplev-mint)
                          (previous-single-property-change (1+ pos) 'maplev-mint))))
                ;; string is like str, but with maplev-variable-spacing
                ;; vars is a comma separated list of names extracted from str
                (while (and (not (string= str ""))
                            (string-match "\\<\\w+\\>" str))
                  (setq vars (cons (match-string 0 str) vars)
                        string (if string
                                   (concat string ","
                                           (make-string maplev-variable-spacing ?\ )
                                           (match-string 0 str))
                                 (match-string 0 str))
                        str (substring str (match-end 0)))))
            (setq string (save-excursion
                           (goto-char pos)
                           (maplev--ident-around-point))
                  vars (list string)))
          ;;
          (cond
           ;; Jump to the start of a procedure in the source.
           ((equal prop 'proc)
            (maplev-mint--goto-source-proc pos))
           ;;
           ;; Jump to the location of an error in the source code.
           ((equal prop 'error)
            (maplev-mint--goto-error pos))
           ;;
           ;; Remove unused args from argument list.
           ((equal prop 'unused-arg)
            (when (maplev-mint-query "Delete `%s' from argument list? " string)
              (maplev-mint--goto-source-proc pos)
              (maplev-delete-vars (maplev--scan-lists -1) (point) vars)))
           ;;
           ;; Remove unused local variables from local declaration.
           ((equal prop 'unused-local)
            (when (maplev-mint-query "Delete `%s' from local statement? " string)
              (maplev-mint--goto-source-proc pos)
              (maplev-delete-declaration "local" vars)))
           ;;
           ;; Remove repeated args from argument list.
           ((equal prop 'repeat-arg)
            (when (maplev-mint-query "Remove duplicate `%s' from parameters? " string)
              (maplev-mint--goto-source-proc pos)
              (maplev-delete-vars (maplev--scan-lists -1) (point) vars 1)))
           ;;
           ;; Remove repeated local variables from local declaration.
           ((equal prop 'repeat-local)
            (when (maplev-mint-query "Remove duplicate `%s' from local statement? " string)
              (maplev-mint--goto-source-proc pos)
              (maplev-delete-declaration "local" vars 1)))
           ;;
           ;; Declaration of undeclared locals variables.
           ((equal prop 'undecl-local)
            (when (maplev-mint-query "Add `%s' to local statement? " string)
              (maplev-mint--goto-source-proc pos)
              (maplev-add-declaration "local" string)))
           ;;
           ;; Declaration of undeclared global variables.
           ((equal prop 'undecl-global)
            (when (maplev-mint-query "Add `%s' to global statement? " string)
              (maplev-mint--goto-source-proc pos)
              (maplev-add-declaration "global" string)))
           ;;
           ;; Goto line
           ((equal prop 'goto-line)
            (maplev-mint--goto-source-line pos))
           )))))

(defun maplev-mint-query (form &rest vars)
  "Return t if correction suggested by mint should be made.
FORM and VARS are used for y-or-n-p query."
  (or (not maplev-mint-query)
      (y-or-n-p (apply 'format form vars))))

;;}}}
;;{{{   regions

(defun maplev-mint-region (beg end)
  "Run Mint on the current region \(from BEG to END\).
Return exit code of mint."
  (interactive "r")
  (let ((code-buffer (current-buffer))
        (code-window (get-buffer-window (current-buffer)))
        (coding-system-for-read maplev-mint-coding-system)
        (mint-buffer (concat "*Mint " maplev-release "*"))
        (mint (nth 2 (cdr (assoc maplev-release maplev-executable-alist))))
        status eoi lines errpos)
    ;; Allocate markers, unless they exist
    (unless maplev-mint--code-beginning
      (setq maplev-mint--code-beginning (make-marker)
            maplev-mint--code-end (make-marker)))
    (set-marker maplev-mint--code-beginning beg)
    (set-marker maplev-mint--code-end end)
    (save-excursion
      (set-buffer (get-buffer-create mint-buffer))
      (setq buffer-read-only nil))
    (copy-to-buffer mint-buffer beg end)
    (save-excursion
      (set-buffer mint-buffer)
      (goto-char (point-max))
      ;; Add a blank line to the end of the buffer, unless there is
      ;; one already.  This is needed for mint to work properly.
      ;; (That's why mint-buffer is used as a temp buffer for mint input.)
      (if (not (bolp)) (newline))
      ;; remember end-of-input
      (setq eoi (point-max))
      ;; Run Mint
      (setq status (apply 'call-process-region
                          (point-min) (point-max)
                          mint nil mint-buffer nil
                          (concat "-i" (number-to-string maplev-mint-info-level)
                                  ;; Add include path to argument list.
                                  ;; Use commas to separate directories (see ?mint)
                                  (and maplev-include-path
                                       (concat " -I " 
                                               (mapconcat 'identity maplev-include-path ","))))
                          maplev-mint-start-options))
      (delete-region (point-min) eoi)
      ;; Display Mint output
      (maplev-mint-mode code-buffer)
      (setq lines (if (= (buffer-size) 0)
                      0
                    (count-lines (point-min) (point-max))))
      (cond ((= lines 0)
             ;; let's assume: no mint output means no "real" error
             ;; This happens with maplev-mint-info-level set to 1
             (setq status 0))
            ((= lines 1)
             (goto-char (point-min))
             (message "%s" (buffer-substring-no-properties
                            (point) (line-end-position))))
            ((> lines 1)
             (display-buffer (current-buffer))))
      ;; If error in maple source (should be identical to status > 0)
      ;; locate position of error
      (goto-char (point-min))
      (if (re-search-forward "^[ \t]*\\^" nil t)
          (setq errpos (maplev-mint--goto-error (point)))))
    ;; If there is an error in the maple source and a window displays it,
    ;; move point in this window
    (if (and code-window errpos)
        (set-window-point code-window errpos))
    status))

(defun maplev-mint-buffer ()
  "Run Mint on the current buffer."
  (interactive)
  (save-restriction
    (widen)
    (maplev-mint-region (point-min) (point-max))))

(defun maplev-mint-procedure ()
  "Run Mint on the current procedure."
  (interactive)
  (apply 'maplev-mint-region (maplev-current-defun)))

(defun maplev-mint-rerun ()
  "Rerun Mint on the previously executed region.
If no region has been selected, run Mint on the buffer."
  (interactive)
  (save-current-buffer
    (if maplev-mint--code-buffer        ; we are in mint buffer
        (set-buffer maplev-mint--code-buffer))
    (if (not maplev-mint--code-beginning)
        (maplev-mint-buffer)
      (maplev-mint-region (marker-position maplev-mint--code-beginning)
                          (marker-position maplev-mint--code-end)))))

;;}}}

;;}}}
;;{{{ History mechanism

;; History of history.
;;
;; Originally this structure was implemented as a browsable stack.
;; New entries were always inserted on the top.  The usage,
;; however, seemed confusing.  Bringing up a new node while browsing
;; the stack would move you to the top of the stack, away from where
;; you were.
;;
;; The new design inserts entries where you are at.  An interesting
;; modification, not implemented (yet) would be to make this a
;; rolodex, that is, a ring rather than a stack.

;;{{{   Module

;; Implement a stack-like structure for providing a history mechanism
;; for the Help and Proc modes.  The stack is a list.  The car of the
;; list is an integer that indexes a particular element in the list;
;; it is used when scrolling through the stack.

(defvar maplev--history-stack nil
  "List containing history of previous `commands'.
The car of the list is an integer that indexes a particular element in
the list, it is used to scroll through the stack.  This is a
buffer-local variable associated with the Maple Help and Maple Proc
output buffers.")

(defun maplev--history-stack-insert (item)
  "Put ITEM into `maplev--history-stack'."
  (let ((pos (car maplev--history-stack)))
    (setcdr (nthcdr pos maplev--history-stack)
            (cons item (nthcdr (1+ pos) maplev--history-stack)))))

(defun maplev--history-stack-prev ()
  "Return the item on `maplev--history-stack' preceding the one last accessed.
If at the bottom of the stack return nil, otherwise increment the pointer."
  (let* ((pos (1+ (car maplev--history-stack)))
         (item (nth pos (cdr maplev--history-stack))))
    (when item
      (setcar maplev--history-stack pos)
      item)))

(defun maplev--history-stack-next ()
  "Return the item on `maplev--history-stack' following the one last accessed.
If at the top of the stack, return nil, otherwise decrement the pointer."
  (let ((pos (1- (car maplev--history-stack))))
    (when (>= pos 0)
      (setcar maplev--history-stack pos)
      (nth pos (cdr maplev--history-stack)))))

(defun maplev--history-stack-top ()
  "Return the top item of `maplev--history-stack'.
Do not change the pointer."
  (nth 1 maplev--history-stack))

(defun maplev--history-stack-current ()
  "Return the currently accessed element of `maplev--history-stack'."
  (nth (car maplev--history-stack) (cdr maplev--history-stack)))

;;}}}
;;{{{   Commands

;;; The following commands process the history items.  The symbol
;;; `maplev--process-item' should be buffer local and assigned the
;;; name of the function that process the items.

(defsubst maplev--process-item-func (item)
  "Apply the function symbol `maplev--process-item' to ITEM."
  (if (stringp item)
      (funcall maplev--process-item item)
    (message "End of stack")))

(defun maplev-history-next-item ()
  "Process the next item on `maplev--history-stack'."
  (interactive)
  (maplev--process-item-func (maplev--history-stack-next)))

(defun maplev-history-prev-item ()
  "Process the previous item on `maplev--history-stack'."
  (interactive)
  (maplev--process-item-func (maplev--history-stack-prev)))

(defun maplev-history-redo-item ()
  "Process the current item on `maplev--history-stack'."
  (interactive)
  (maplev--process-item-func (maplev--history-stack-current)))

(defun maplev-history-delete-item ()
  "Delete current item from `maplev--history-stack'."
  (interactive)
  (when maplev--history-stack
    (let ((pos (car maplev--history-stack)))
      (setcdr (nthcdr pos maplev--history-stack)
              (nthcdr (+ 2 pos) maplev--history-stack))
      (unless (nth pos (cdr maplev--history-stack))
        (setcar maplev--history-stack (setq pos (1- pos))))
      (if (>= pos 0)
          (maplev--process-item-func (maplev--history-stack-current))
        (kill-buffer nil)))))

(defun maplev-history-clear ()
  "Assign `maplev--history-stack' an empty stack."
  (interactive)
  (setq maplev--history-stack (list 0)))

(defun maplev--history-stack-process (item &optional hide)
  "Insert ITEM into `maplev--history-stack' and process it.
Do not insert ITEM into the stack if it is already at the current
or following position.
If optional arg HIDE is non-nil do not display buffer."
  (let ((pos (car maplev--history-stack)))
    (unless (or (string= item (maplev--history-stack-current))
                (and (/= pos 0)
                     (string= item (nth pos maplev--history-stack))))
      (maplev--history-stack-insert item))
    (maplev--process-item-func item)
    (unless hide
      (let ((pop-up-frames maplev-pop-up-frames-flag))
        (display-buffer (current-buffer) nil (not maplev-xemacsp))))))

;;}}}

;;}}}
;;{{{ Frames

;; The following is a slightly modified version of
;; `mouse-tear-off-window' from mouse.el.

(defun maplev-tear-off-window ()
  "Delete the current window and create a new frame displaying its buffer."
  (interactive)
  (if (one-window-p t 'here)
      (message "Only one window in frame.")
    (let* ((window (selected-window))
           (buf (window-buffer window))
           (frame (make-frame)))
      (select-frame frame)
      (switch-to-buffer buf)
      (delete-window window))))

;;}}}

(provide 'maplev)

;;; maplev.el ends hereemacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/keydef.el0000775000000000000000000004065512230377265021051 0ustar  ;;; keydef.el --- a simpler way to define keys, with kbd syntax

;; Emacs Lisp Archive Entry
;; Filename: keydef.el
;; Author: Michael John Downes 
;; Created: 2001/01/18
;; Keywords: convenience lisp customization keyboard keys
;; Version: 1.16
;; $Revision: 1.1.1.1 $ $Date: 2003-04-04 20:16:06 $

;; This program was placed in the public domain on 2001/01/18 by the
;; Author. The 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.

;;; Commentary:

;;; The macro keydef provides a simplified interface to define-key that
;;; smoothly handles a number of common complications.

;;; The global-set-key command isn't ideal for novices because of its
;;; relatively complex syntax. And I always found it a little
;;; inconvenient to have to quote the name of the command---that is, I
;;; tend to forget the quote every once in a while and then have to go
;;; back and fix it after getting a load error.

;;; One of the best features is that you can give an Emacs lisp form (or
;;; even a series of forms) as the key definition argument, instead of a
;;; command name, and the keydef macro will automatically add an
;;; interactive lambda wrapper. I use this to get, for example, a more
;;; emphatic kill-buffer command (no confirmation query) by writing
;;;
;;;   (keydef "" (kill-buffer nil))
;;;
;;; For keydef the key sequence is expected to be given uniformly in the
;;; form of a string for the 'kbd' macro, with one or two refinements
;;; that are intended to conceal from users certain points of confusion,
;;; such as (for those whose keyboards lack a Meta key) the whole
;;; Meta/ESC/escape muddle.

;;; I have had some trouble in the past regarding the distinction
;;; between ESC and [escape] (in a certain combination of circumstances
;;; using the latter form caused definitions made with the other form to
;;; be masked---most puzzling when I wasn't expecting it). Therefore the
;;; ESC form is actually preprocessed a bit to ensure that the binding
;;; goes into esc-map.

;;; There is one other special feature of the key sequence syntax
;;; expected by the keydef macro: You can designate a key definition for
;;; a particular mode-map by giving the name of the mode together with
;;; the key sequence string in list form, for example
;;;
;;;   (keydef (latex "C-c %") comment-region)
;;;
;;; This means that the key will be defined in latex-mode-map. [The
;;; point of using this particular example will be made clear below.] I
;;; arranged for the mode name to be given in symbol form just because I
;;; didn't want to have to type extra quotes if I could get away with
;;; it. For the same reason this kind of first arg is not written in
;;; dotted pair form.

;;; If the given mode-map is not defined, keydef "does the right thing"
;;; using eval-after-load. In order to determine what library the
;;; mode-map will be loaded from, it uses the following algorithm:
;;;
;;; First check if foo-mode has autoload information. If not, check
;;; whether "foo-mode" is the name of a library that can be found
;;; somewhere in the load-path (using locate-library); otherwise check
;;; whether "foo" is the name of a locatable library. Failing that, give
;;; up and return nil.
;;;
;;; There is a fall-back mechanism, however, to handle exceptional
;;; cases. If foo-mode-map is undefined but the list mode-map-alist
;;; contains an entry of the form (foo-mode-map foo-other-name-map),
;;; then foo-other-name-map is used as the name of the
;;; keymap.
;;;
;;; If the mode-map is not loaded yet AND the command being bound to a
;;; key is undefined at the time of the keydef assignment, it presents
;;; further problems. The simplest solution is to assume that after the
;;; package is loaded that defines the mode-map, the given command will
;;; be defined and satisfy commandp. With some extra effort it should be
;;; possible to determine more accurately whether the command will be
;;; defined or not, but I'm not sure I want to go to that extreme, since
;;; as far as I can see it would require opening the package file and
;;; searching through it for a matching defun/defalias/fset statement.
;;;
;;; If the mode name matches the mode map name, but foo-mode is not
;;; autoloaded, then some autoload information may need to be provided.
;;; For example, the following line allows definitions to be made for
;;; debugger-mode-map even before debug.el is loaded.
;;;
;;;  (autoload 'debugger-mode "debug" "Autoloaded." 'interactive)
;;;
;;; Although there is no easy way provided by keydef for
;;; gnus-summary-limit-map to be accessed directly, because
;;; its name does not include "mode", you can get a binding into
;;; such a map by writing
;;;
;;;   (keydef (gnus-summary "/ z") gnus-summary-limit-to-zapped)
;;;
;;; which binds /z in gnus-summary-mode-map, which is equivalent to
;;; binding z in gnus-summary-limit-map.
;;;
;;; You might need to add an autoload statement for gnus-summary-mode
;;; in order for this to work, so that keydef knows that it should use
;;; eval-after-load and that the file the mode function will be loaded
;;; from is called "gnus-sum" rather than "gnus-summary-mode". (If it
;;; were the latter, keydef would be able to resolve everything
;;; automatically.)

;;; We COULD HAVE just put the definitions into the mode hook in the
;;; standard way, instead of using eval-after-load, but that would mean
;;; the key definitions get executed repetitiously every time the mode
;;; function gets called, which seems better to avoid, if only for
;;; esthetic reasons (if it can be done without too much trouble).

;;; The following examples show some typical keydef lines followed by the
;;; results of the macro expansion.

;;; Simplest kind of definition:
;;;
;;; (keydef "C-x m" gnus-group-mail)
;;;
;;;   -->(define-key global-map (kbd "C-x m") (quote gnus-group-mail))

;;; What if the command name is misspelled?
;;;
;;; (keydef "C-x m" gnus-gruop-mail)
;;;
;;;   -->(message "keydef: gnus-gruop-mail unknown \
;;;                \(perhaps misspelled, or not loaded yet\)")

;;; A leading ESC gets special handling to go through esc-map.
;;;
;;; (keydef "ESC &" query-replace-regexp)
;;;
;;;   -->(define-key esc-map (kbd "&") (quote query-replace-regexp))

;;; Undefine a key:
;;;
;;; (keydef "ESC `")
;;;
;;;   -->(define-key esc-map (kbd "`") nil)

;;; If the second arg is a string, keydef defines the given key sequence
;;; as a keyboard macro. The following macro puts in TeX-style double
;;; quotes and then moves the cursor backward to leave it in the middle:
;;;
;;; (keydef "\"" "``''\C-b\C-b")
;;;
;;;   -->(define-key global-map (kbd "\"") "``''\002\002")

;;; Reset a key to self-insert
;;;
;;; (keydef "\"" "\"")
;;;
;;;   -->(define-key global-map (kbd "\"") (quote self-insert-command))

;;; If the second arg is a list, wrap it in an interactive lambda form.
;;;
;;; (keydef "C-z"
;;;   (message "Control-Z key disabled---redefine it if desired."))
;;;
;;;   -->(define-key global-map
;;;       (kbd "C-z")
;;;       (lambda (arg)
;;;         "anonymous keydef function"
;;;         (interactive "p")
;;;         (message "Control-Z key disabled---redefine it if desired.")))
;;;
;;; Note that the interactive lambda wrapper added by keydef, when the
;;; CMD does not satisfy commandp, always takes a single prefix argument
;;; named "arg", which is read in the usual way with (interactive "p");
;;; so this could be used in the body of the function if need be.

;;; This shows the notation for F-keys.
;;;
;;; (keydef "" (kill-buffer nil))
;;;
;;;   -->(define-key global-map
;;;       (kbd "")
;;;       (lambda (arg)
;;;         "*Anonymous function created by keydef."
;;;         (interactive "p")
;;;         (kill-buffer nil)))

;;; Because of the confusing Meta/Escape complications, I recommend to
;;; the users that I support that they use the ESC notation
;;; consistently if that is what they type from their keyboard, even
;;; for F-key definitions that might normally be written with 
;;; notation.
;;;
;;; (keydef "ESC " find-file-read-only)
;;;
;;;   -->(define-key esc-map (kbd "") (quote find-file-read-only))

;;; The next two definitions go together. The second one shows how to
;;; write a mode-specific definition.
;;;
;;; (keydef "" isearch-forward)
;;;
;;;   -->(define-key global-map (kbd "") (quote isearch-forward))
;;;
;;; (keydef (isearch "") isearch-repeat-forward)
;;;
;;;   -->(define-key isearch-mode-map (kbd "")
;;;                                   (quote isearch-repeat-forward))

;;; Making a definition for a mode-map that is not loaded yet.
;;;
;;; (keydef (latex "C-c %") comment-region)
;;;
;;;   -->(eval-after-load "tex-mode"
;;;        (quote
;;;         (define-key latex-mode-map
;;;           (kbd "C-c %")
;;;           (quote comment-region))))

;;; Code:

;;; TO DO:
;;;
;;; ---If someone wants to do massive alterations or additions to a
;;; mode-map that is not yet loaded, it might be a good idea to
;;; provide another macro that will bundle them into a single
;;; eval-after-load call rather than dozens of separate ones.
;;;
;;; ---More error-checking would probably be a good idea, when SEQ
;;; satisfies listp but the contents of the list are not usable in the
;;; way that we expect.

;; This variable is needed because the information is not readily
;; available for look-up in any other way. (Well, I don't want to get
;; into defadvice'ing use-local-map and stuff like that.)
(defvar mode-map-alist
  (list
   (quote (latex-mode tex-mode-map))
   (quote (shell-script-mode sh-mode-map)))
  "If the local keymap for foo-mode is bar-mode-map instead of
foo-mode-map, this alist allows you to specify what corresponds to
what. The car of each pair should be a major mode name and the cdr
should be the name of the local map that is used for that mode.")

;;; If the mode name matches the mode map name, but foo-mode is not
;;; autoloaded, then some autoload information may need to be provided.
;;; For example, the following line allows definitions to be made for
;;; debugger-mode-map even before debug.el is loaded. This line would
;;; not be necessary if debugger-mode were already declared as an
;;; autoloaded function.
(autoload 'debugger-mode "debug" "Autoloaded." 'interactive)

(defun keydef-lib-lookup (mode)
  "For a not-already-loaded mode function, try to determine what library
it would be loaded from: First check for autoload information, otherwise
check if a library file matching the mode name can be found in the load
path, with or without the -mode suffix. Failing that, give up."
  (let* ((modesym (intern mode))
         (fcar (and (fboundp modesym) (car (symbol-function modesym)))))
    (cond
     ((eq fcar 'autoload)
      (car (cdr (symbol-function modesym))))
     ((locate-library mode)
      mode)
     (t
      (let ((shortmode (substring mode 0 -5))) ; chop "-mode" from the end
        (if (locate-library shortmode)
            shortmode))))))

;;;###autoload
(defmacro keydef (seq &rest cmd)
  "Define the key sequence SEQ, written in kbd form, to run CMD.
CMD is automatically wrapped in an anonymous interactive function if it
is Emacs Lisp code rather than a command name. SEQ may also have the form
\(MODE SEQ\) where the car is a mode name\; for example

  \(keydef \(latex \"C-c %\"\) comment-region\)

means to define the given key in latex-mode-map. And this will work even
if latex-mode is not loaded yet, provided that it is possible to deduce
the file that it will be loaded from, either from the autoload info or
by searching for a matching file name in the Emacs load path.

For best results, the \"mode name\" that you use here should yield the
proper foo-mode-map symbol when \"-mode-map\" is appended\; although
this will normally match the mode name as given in the mode line,
Shell-script is one example I can think of where it doesn't---the map is
named sh-mode-map. The common cases that I know about, including
shell-script-mode and latex-mode, are handled as exceptions through the
variable mode-map-alist. But for other cases you will need to look up
the name of the mode-map that goes with the given mode."
  (let ((map (quote global-map))
        (modestring)
        (loaded t))
    ;; If seq is a list, the car indicates a mode-specific map that we
    ;; should use instead of global-map.
    (if (and (listp seq)
             (symbolp (car seq))
             (stringp (car (cdr seq))))
        (let ((othermap))
          (setq modestring
                (format "%s-mode"
                        (downcase (symbol-name (car seq)))))
          (setq othermap (assq (intern modestring) mode-map-alist))
          (if othermap
              (setq map (nth 1 othermap))
            (setq map (intern (format "%s-map" modestring))))
          (if (not (and (boundp map) (keymapp (symbol-value map))))
              (setq loaded nil))
          (setq seq (car (cdr seq)))))
    (cond
     ((stringp seq)
      (if (string-match "^ESC " seq)
          (progn
            (setq seq (substring seq 4))
            (setq map (quote esc-map)))))
     (t
      (if (vectorp seq)
          (error
"keydef: '%s' vector form disallowed here, use kbd syntax instead."
           (prin1-to-string seq))
        (error "keydef: Invalid key sequence '%s'" (prin1-to-string seq)))))
    (if (not (null cmd))
        (let ((token (car cmd)))
          ;; Note that commandp is true for strings. So we have to be a
          ;; little careful about the order of tests here.
          (cond
           ;; This case arises when an explicit second arg of nil is given.
           ((eq token nil)
            (setq cmd nil))
           ;; If someone forgets that keydef does not require you to
           ;; quote the command name, we had better make sure it works
           ;; anyway.
           ((eq (car-safe token) 'quote)
            (setq cmd token))
           ;; If the CMD is a one-character string that matches the SEQ, use
           ;; self-insert-command as the binding. Otherwise it will be a macro
           ;; that will run an infinite loop until specpdl-size is exceeded.
           ((stringp token)
            (if (and (= (length token) 1)
                     (string-equal token seq))
                (setq cmd '(quote self-insert-command))
              (setq cmd token)))        ; kbd macro string
           ;; If the command is a simple command name---or a keymap,
           ;; such as help-command---use it directly as the
           ;; definition.
           ((and (or (commandp token) (keymapp token))
                 (= (length cmd) 1))
            (setq cmd `(quote ,token)))
           ;; If the command looks like a simple command name but fails the
           ;; commandp test, then probably it was misspelled; if it passes the
           ;; fboundp test, however, make a lambda wrapper similar to the next
           ;; case. Could try to work harder at getting the arguments right in
           ;; that case, but for now just assume it has zero args.
           ((and (= (length cmd) 1) (symbolp token))
            (cond
             ((fboundp token)
              (setq cmd
                    (append
                     '(lambda (arg) "*Anonymous function created by keydef."
                        (interactive "p"))
                     (list cmd))))
             ((not loaded)
              ;; If the mode-map is not loaded yet, assume that the
              ;; command will become defined when the package is loaded.
              (setq cmd `(quote ,token)))
             (t
              ;; Unknown command is being added to a known map. Probably
              ;; misspelled?
              (setq cmd `(quote ,token))
              (message
               "keydef: '%s' unknown %s"
               (prin1-to-string token)
               "\(perhaps misspelled, or needs autoload info?\)"))))
           (t
            ;; We have what seems to be a list of code elements. Create
            ;; an anonymous function wrapper.
            (setq cmd
                  (append
                   '(lambda (arg)
                      "*Anonymous function created by keydef."
                      (interactive "p"))
                   cmd))))))
    (if (and (not loaded) modestring)
        (let ((loadfrom (keydef-lib-lookup modestring)))
          (if loadfrom
              `(eval-after-load ,loadfrom
                 (quote (define-key ,map (kbd ,seq) ,cmd)))
            (message "keydef: '%s' unknown %s"
                     modestring
                     "\(perhaps misspelled, or needs autoload info?\)")))
      `(define-key ,map (kbd ,seq) ,cmd))))

(provide 'keydef)
;;; keydef.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/tld.el0000775000000000000000000002626612230377266020370 0ustar  ;;; tld.el --- TLD lookup tool.
;; Copyright 2000-2008 by Dave Pearson 
;; $Revision: 1.3 $

;; tld.el is free software distributed under the terms of the GNU General
;; Public Licence, version 2 or (at your option) any later version. For
;; details see the file COPYING.

;;; Commentary:
;;
;; tld.el provides a command for looking up TLDs, either by searching for a
;; specific TLD or by searching country names.
;;
;; One command is provided: `tld'.
;;
;; The latest tld.el is always available from:
;;
;;   
;;
;; Note that, to some degree, this code duplicates the functionality
;; provided by `what-domain' (a command that is part of emacs). tld.el
;; differs slightly in that it allows for both TLD and country name
;; searches. Also, compared to emacs 20.7, the list of TLDs is more complete
;; (yes, I know, I should submit a patch to the emacs maintainers, I will at
;; some point).

;;; INSTALLATION:
;;
;; o Drop tld.el somwehere into your `load-path'. Try your site-lisp
;;   directory for example (you might also want to byte-compile the file).
;;
;; o Add the following autoload statement to your ~/.emacs file:
;;
;;   (autoload 'tld "tld" "Perform a TLD lookup" t)

;;; Code:

;; Things we need:

(eval-when-compile
  (require 'cl))

;; Constants.

(defconst tld-list
    '(("AC"     . "Ascension Island")
      ("AD"     . "Andorra")
      ("AE"     . "United Arab Emirates")
      ("AF"     . "Afghanistan")
      ("AG"     . "Antigua and Barbuda")
      ("AI"     . "Anguilla")
      ("AL"     . "Albania")
      ("AM"     . "Armenia")
      ("AN"     . "Netherlands Antilles")
      ("AO"     . "Angola")
      ("AQ"     . "Antartica")
      ("AR"     . "Argentina")
      ("ARPA"   . "Old style Arpanet obsolete")
      ("AS"     . "American Samoa")
      ("AT"     . "Austria")
      ("AU"     . "Australia")
      ("AW"     . "Aruba")
      ("AZ"     . "Azerbaijan")
      ("BA"     . "Bosnia and Herzegovina")
      ("BB"     . "Barbados")
      ("BD"     . "Bangladesh")
      ("BE"     . "Belgium")
      ("BF"     . "Burkina Faso")
      ("BG"     . "Bulgaria")
      ("BH"     . "Bahrain")
      ("BI"     . "Burundi")
      ("BITNET" . "Pseudo-domain for EARN/BITNET gateway")
      ("BJ"     . "Benin")
      ("BM"     . "Bermuda")
      ("BN"     . "Brunei Darussalam")
      ("BO"     . "Bolivia")
      ("BR"     . "Brazil")
      ("BS"     . "Bahamas")
      ("BT"     . "Bhutan")
      ("BV"     . "Bouvet Island")
      ("BW"     . "Botswana")
      ("BY"     . "Belarus")
      ("BZ"     . "Belize")
      ("CA"     . "Canada")
      ("CC"     . "Cocos (Keeling) Islands")
      ("CD"     . "Congo, Democratic People's Republic")
      ("CF"     . "Central African Republic")
      ("CG"     . "Congo, Republic of")
      ("CH"     . "Switzerland")
      ("CI"     . "Cote d'Ivoire")
      ("CK"     . "Cook Islands")
      ("CL"     . "Chile")
      ("CM"     . "Cameroon")
      ("CN"     . "China")
      ("CO"     . "Colombia")
      ("COM"    . "Commercial")
      ("CR"     . "Costa Rica")
      ("CU"     . "Cuba")
      ("CV"     . "Cap Verde")
      ("CX"     . "Christmas Island")
      ("CY"     . "Cyprus")
      ("CZ"     . "Czech Republic")
      ("DE"     . "Germany")
      ("DJ"     . "Djibouti")
      ("DK"     . "Denmark")
      ("DM"     . "Dominica")
      ("DO"     . "Dominican Republic")
      ("DZ"     . "Algeria")
      ("EC"     . "Ecuador")
      ("EDU"    . "Educational: US only (universities)")
      ("EE"     . "Estonia")
      ("EG"     . "Egypt")
      ("EH"     . "Western Sahara")
      ("ER"     . "Eritrea")
      ("ES"     . "Spain")
      ("ET"     . "Ethiopia")
      ("FI"     . "Finland")
      ("FJ"     . "Fiji")
      ("FK"     . "Falkland Islands (Malvina)")
      ("FM"     . "Micronesia, Federal State of")
      ("FO"     . "Faroe Islands")
      ("FR"     . "France")
      ("GA"     . "Gabon")
      ("GB"     . "Great Britain (UK)")
      ("GD"     . "Grenada")
      ("GE"     . "Georgia")
      ("GF"     . "French Guiana")
      ("GG"     . "Guernsey")
      ("GH"     . "Ghana")
      ("GI"     . "Gibraltar")
      ("GL"     . "Greenland")
      ("GM"     . "Gambia")
      ("GN"     . "Guinea")
      ("GOV"    . "US Government")
      ("GP"     . "Guadeloupe")
      ("GQ"     . "Equatorial Guinea")
      ("GR"     . "Greece")
      ("GS"     . "South Georgia and the South Sandwich Islands")
      ("GT"     . "Guatemala")
      ("GU"     . "Guam")
      ("GW"     . "Guinea-Bissau")
      ("GY"     . "Guyana")
      ("HK"     . "Hong Kong")
      ("HM"     . "Heard and McDonald Islands")
      ("HN"     . "Honduras")
      ("HR"     . "Croatia/Hrvatska")
      ("HT"     . "Haiti")
      ("HU"     . "Hungary")
      ("ID"     . "Indonesia")
      ("IE"     . "Ireland")
      ("IL"     . "Israel")
      ("IM"     . "Isle of Man")
      ("IN"     . "India")
      ("INT"    . "International field: Nato")
      ("IO"     . "British Indian Ocean Territory")
      ("IQ"     . "Iraq")
      ("IR"     . "Iran (Islamic Republic of)")
      ("IS"     . "Iceland")
      ("IT"     . "Italy")
      ("JE"     . "Jersey")
      ("JM"     . "Jamaica")
      ("JO"     . "Jordan")
      ("JP"     . "Japan")
      ("KE"     . "Kenya")
      ("KG"     . "Kyrgyzstan")
      ("KH"     . "Cambodia")
      ("KI"     . "Kiribati")
      ("KM"     . "Comoros")
      ("KN"     . "Saint Kitts and Nevis")
      ("KP"     . "Korea, Democratic People's Republic")
      ("KR"     . "Korea, Republic of")
      ("KW"     . "Kuwait")
      ("KY"     . "Cayman Islands")
      ("KZ"     . "Kazakhstan")
      ("LA"     . "Lao People's Democratic Republic")
      ("LB"     . "Lebanon")
      ("LC"     . "Saint Lucia")
      ("LI"     . "Liechtenstein")
      ("LK"     . "Sri Lanka")
      ("LR"     . "Liberia")
      ("LS"     . "Lesotho")
      ("LT"     . "Lithuania")
      ("LU"     . "Luxembourg")
      ("LV"     . "Latvia")
      ("LY"     . "Libyan Arab Jamahiriya")
      ("MA"     . "Morocco")
      ("MC"     . "Monaco")
      ("MD"     . "Moldova, Republic of")
      ("MG"     . "Madagascar")
      ("MH"     . "Marshall Islands")
      ("MIL"    . "Military: US only")
      ("MK"     . "Macedonia, Former Yugoslav Republic")
      ("ML"     . "Mali")
      ("MM"     . "Myanmar")
      ("MN"     . "Mongolia")
      ("MO"     . "Macau")
      ("MP"     . "Northern Mariana Islands")
      ("MQ"     . "Martinique")
      ("MR"     . "Mauritania")
      ("MS"     . "Montserrat")
      ("MT"     . "Malta")
      ("MU"     . "Mauritius")
      ("MV"     . "Maldives")
      ("MW"     . "Malawi")
      ("MX"     . "Mexico")
      ("MY"     . "Malaysia")
      ("MZ"     . "Mozambique")
      ("NA"     . "Namibia")
      ("NATO"   . "Nato field: obsolete")
      ("NC"     . "New Caledonia")
      ("NE"     . "Niger")
      ("NET"    . "Network")
      ("NF"     . "Norfolk Island")
      ("NG"     . "Nigeria")
      ("NI"     . "Nicaragua")
      ("NL"     . "Netherlands")
      ("NO"     . "Norway")
      ("NP"     . "Nepal")
      ("NR"     . "Nauru")
      ("NT"     . "Neutral Zone")
      ("NU"     . "Niue")
      ("NZ"     . "New Zealand")
      ("OM"     . "Oman")
      ("ORG"    . "Non-Profit Organization")
      ("PA"     . "Panama")
      ("PE"     . "Peru")
      ("PF"     . "French Polynesia")
      ("PG"     . "Papua New Guinea")
      ("PH"     . "Philippines")
      ("PK"     . "Pakistan")
      ("PL"     . "Poland")
      ("PM"     . "St. Pierre and Miquelon")
      ("PN"     . "Pitcairn Island")
      ("PR"     . "Puerto Rico")
      ("PS"     . "Palestinian Territories")
      ("PT"     . "Portugal")
      ("PW"     . "Palau")
      ("PY"     . "Paraguay")
      ("QA"     . "Qatar")
      ("RE"     . "Reunion Island")
      ("RO"     . "Romania")
      ("RU"     . "Russian Federation")
      ("RW"     . "Rwanda")
      ("SA"     . "Saudi Arabia")
      ("SB"     . "Solomon Islands")
      ("SC"     . "Seychelles")
      ("SD"     . "Sudan")
      ("SE"     . "Sweden")
      ("SG"     . "Singapore")
      ("SH"     . "St. Helena")
      ("SI"     . "Slovenia")
      ("SJ"     . "Svalbard and Jan Mayen Islands")
      ("SK"     . "Slovak Republic")
      ("SL"     . "Sierra Leone")
      ("SM"     . "San Marino")
      ("SN"     . "Senegal")
      ("SO"     . "Somalia")
      ("SR"     . "Suriname")
      ("ST"     . "Sao Tome and Principe")
      ("SU"     . "Soviet Union")
      ("SV"     . "El Salvador")
      ("SY"     . "Syrian Arab Republic")
      ("SZ"     . "Swaziland")
      ("TC"     . "Turks and Ciacos Islands")
      ("TD"     . "Chad")
      ("TF"     . "French Southern Territories")
      ("TG"     . "Togo")
      ("TH"     . "Thailand")
      ("TJ"     . "Tajikistan")
      ("TK"	. "Tokelau")
      ("TM"	. "Turkmenistan")
      ("TN"	. "Tunisia")
      ("TO"	. "Tonga")
      ("TP"	. "East Timor")
      ("TR"	. "Turkey")
      ("TT"	. "Trinidad and Tobago")
      ("TV"	. "Tuvalu")
      ("TW"	. "Taiwan")
      ("TZ"	. "Tanzania")
      ("UA"	. "Ukraine")
      ("UG"	. "Uganda")
      ("UK"	. "United Kingdom")
      ("UM"	. "US Minor Outlying Islands")
      ("US"	. "United States")
      ("UUCP"	. "Pseudo-domain for UUCP gateway")
      ("UY"	. "Uruguay")
      ("UZ"	. "Uzbekistan")
      ("VA"	. "Holy See (City Vatican State)")
      ("VC"	. "Saint Vincent and the Grenadines")
      ("VE"	. "Venezuela")
      ("VG"	. "Virgin Islands (British)")
      ("VI"	. "Virgin Islands (USA)")
      ("VN"	. "Vietnam")
      ("VU"	. "Vanuatu")
      ("WF"	. "Wallis and Futuna Islands")
      ("WS"	. "Western Samoa")
      ("YE"	. "Yemen")
      ("YT"	. "Mayotte")
      ("YU"	. "Yugoslavia")
      ("ZA"	. "South Africa")
      ("ZM"	. "Zambia")
      ("ZR"	. "Zaire")
      ("ZW"	. "Zimbabwe"))
  "Association list of TLDs.")

;; Main code.

(defsubst tld-tld (tld)
  "Return the TLD portion of a TLD pair."
  (car tld))

(defsubst tld-name (tld)
  "Return the name portion of a TLD pair."
  (cdr tld))

(defun tld-find-tld (tld)
  "Lookup a TLD.

If found a (TLD . NAME) pair is returned."
  (assoc (upcase tld) tld-list))

(defun tld-find-name (name)
  "Lookup a name.

Returns a list of hits."
  (let ((case-fold-search t))
    (loop for tld in tld-list
          when (string-match name (tld-name tld))
          collect tld)))

;;;###autoload
(defun tld (search)
  "Search the TLD list."
  (interactive "sSearch: ")
  (let* ((tld-lookup (string= (substring search 0 1) "."))
         (result     (if tld-lookup (tld-find-tld (substring search 1)) (tld-find-name search))))
    (if result
        (flet ((message-tld (tld)
                 (message "%s is %s" (tld-tld tld) (tld-name tld))))
          (if tld-lookup
              (message-tld result)
            (if (= (length result) 1)
                (message-tld (car result))
              (with-output-to-temp-buffer "*tld*"
                (princ "TLD    Name\n====== ========================================\n\n")
                (loop for tld in result
                      do (princ (format "%-6s %s\n" (tld-tld tld) (tld-name tld))))))))
      ;; If nothing was found and it wasn't a tld-lookup but it looks like
      ;; it might be a TLD re-submit it with a leading dot.
      (if (and (not tld-lookup) (< (length search) 7))
          (tld (concat "." search))
        (error "No TLD match found")))))

(provide 'tld)

;;; tld.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/mutt-alias.el0000775000000000000000000000777012230377265021663 0ustar  ;;; mutt-alias.el --- Lookup/insert mutt mail aliases.
;; Copyright 1999-2008 by Dave Pearson 
;; $Revision: 1.3 $

;; mutt-alias is free software distributed under the terms of the GNU
;; General Public Licence, version 2 or (at your option) any later version.
;; For details see the file COPYING.

;;; Commentary:
;;
;; mutt-alias allows you to lookup and insert the expansion of mutt mail
;; aliases. This is only handy if you use mutt .

;;; TODO:
;;
;; o No attempt is made to handle aliases in aliases.
;; o No attempt is made to handle line continuation.

;;; Code:

;; Things we need:

(require 'cl)

;; Attempt to handle older/other emacs.
(eval-and-compile
  ;; If customize isn't available just use defvar instead.
  (unless (fboundp 'defgroup)
    (defmacro defgroup  (&rest rest) nil)
    (defmacro defcustom (symbol init docstring &rest rest)
      `(defvar ,symbol ,init ,docstring))))

;; Customize options.

(defgroup mutt-alias nil
  "Lookup mutt mail aliases."
  :group  'mail
  :prefix "mutt-alias-")

(defcustom mutt-alias-file-list '("~/.mutt/aliases")
  "*List of files that contain your mutt aliases."
  :type  '(repeat (file :must-exist t))
  :group 'mutt-alias)

(defcustom mutt-alias-cache t
  "*Should we cache the aliases?"
  :type  '(choice (const :tag "Always cache the alias list" t)
                  (const :tag "Always re-load the alias list" nil))
  :group 'mutt-alias)

;; Non-customize variables.

(defvar mutt-alias-aliases nil
  "\"Cache\" of aliases.")

;; Main code:

(defun mutt-alias-load-aliases ()
  "Load aliases from files defined in `mutt-alias-file-list'.

The resulting list is an `assoc' list where the `car' is a string
representation of the alias and the `cdr' is the expansion of the alias.
Note that no attempt is made to handle aliases-in-expansions or continued
lines."
  (unless (and mutt-alias-aliases mutt-alias-cache)
    (with-temp-buffer
      (loop for file in mutt-alias-file-list do (insert-file-contents file))
      (setf (point) (point-min))
      (setq mutt-alias-aliases
            (loop while (search-forward-regexp "^[ \t]*alias +" nil t)
                  collect (mutt-alias-grab-alias)))))
  mutt-alias-aliases)

(defun mutt-alias-grab-alias ()
  "Convert an alias line into a cons.

The resulting `cons' has a `car' that is the alias and the `cdr' is the
expansion. Note that no attempt is made to handle continued lines."
  (let ((old-point (point))
        (end-point)
        (alias)
        (expansion))
    (end-of-line)
    (setq end-point (point))
    (setf (point) old-point)
    (search-forward-regexp "[ \t]" nil t)
    (setq alias (buffer-substring-no-properties old-point (1- (point))))
    (search-forward-regexp "[^ \t]" nil t)
    (setq expansion (buffer-substring-no-properties (1- (point)) end-point))
    (setf (point) old-point)
    (cons alias expansion)))

(defun mutt-alias-expand (alias)
  "Attempt to expand an alias."
  (let ((expansion (assoc alias (mutt-alias-load-aliases))))
    (when expansion
      (cdr expansion))))

(put 'mutt-alias-interactive 'lisp-indent-function 3)

(defmacro mutt-alias-interactive (name alias expansion doc &rest body)
  "Generate a function that asks for an alias.

The alias is placed into variable named by ALIAS and places it into the
variable named by EXPANSION. If there is an expansion BODY will be evaluated
otherwise an error is reported. The function will be given a doc string of
DOC."
  `(defun ,name (,alias) ,doc
     (interactive (list (completing-read "Alias: " (mutt-alias-load-aliases))))
     (let ((,expansion (mutt-alias-expand ,alias)))
       (if ,expansion
           (progn
             ,@body)
         (error "Unknown alias \"%s\"" ,alias)))))

(mutt-alias-interactive mutt-alias-insert alias expansion
  "Insert the expansion for ALIAS into the current buffer."
  (insert expansion))

(mutt-alias-interactive mutt-alias-lookup alias expansion
  "Lookup and display the expansion for ALIAS."
  (message "%s: %s" alias expansion))

(provide 'mutt-alias)

;;; mutt-alias.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/emacs-goodies-loaddefs.make0000775000000000000000000000037512230377265024410 0ustar   emacs -batch --no-site-file --multibyte --eval '(setq load-path (cons "." load-path))' -l autoload --eval '(setq generated-autoload-file (expand-file-name "emacs-goodies-loaddefs.el"))' --eval '(setq make-backup-files nil)' -f batch-update-autoloads .
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/todoo.el0000775000000000000000000004047612230377265020727 0ustar  ;; todoo.el -- Major mode for editing TODO files

;; Copyright (C) 1999 Daniel Lundin 

;; Author: Daniel Lundin 
;; Maintainer: Daniel Lundin 
;; Created: 6 Mar 2001
;; Version: 1.2
;; Keywords: TODO, todo, project management

;; This file is NOT (yet) part of GNU Emacs.

;; This 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 2, or (at your option)
;; any later version.

;; This software 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; ----------------------------------------------------------------------

;;; Commentary:

;;  todoo.el is a mode for editing TODO files in an outline-mode fashion. 
;;  It has similarities to Oliver Seidel's todo-mode.el , but todoo.el
;;  has  been significantly simplified to better adhere to mine and
;;  other users' needs at the time. 

;; Installation example (~/.emacs):

;; (autoload 'todoo "todoo" "TODO Mode" t)
;; (add-to-list 'auto-mode-alist '("TODO$" . todoo-mode))

;; To show your personal todo-list:
;; M-x todoo

;; To be prompted a filename, supply any prefix to 'todoo':
;; C-u M-x todoo

;; For information on keybindings:
;; C-h f todoo-mode RET

;; Customize your todoo with:
;; M-x customize-group RET  todoo RET

;; Thanks to Kai Grossjohann for immediate feedback on the first
;; version, eventually leading to this more fit-for-human-consumption version.


;;; ChangeLog:

;; 1.2 - Fixed bug in menu (todoo-show->todoo)
;;       Fixed bug when deleting window in todoo-save-and-exit
;;       Added early sub-item support (might be buggy, but still
;;          useful). 
;;       Added todoo-hide-item and todoo-show-item
;;       Added pop up menu
;;       Cleaned up keybindingss
;;       Cleaned up menubar
;;
;; 1.1 - Code cleanup, renamed it todoo.el and made it more 
;; 1.0 - First version, derived from Olver Seidel's todo-mode.el

;;; Todo

;; * Extend item to be able to have at least one level of sub items 
;; * Insert items into a worklog.el worklog file upon removal for
;;   tracking progress.

;;; Code:

;; Required packages
(require 'outline)
(require 'custom)
(require 'easymenu)

(defgroup todoo nil
  "Maintain a list of todo items."
  :group 'calendar)


(defcustom todoo-show-pop-up-window t
  "*Wether to use a pop up window for 'todoo-show'."
  :type 'boolean
  :group 'todoo)

(defcustom todoo-collapse-items nil
  "*Wether to hide the body of multiline items."
  :type 'boolean
  :group 'todoo)

(defcustom todoo-indent-column 3
  "*Indent item body to 'todoo-indent-column' column."
  :type 'integer
  :group 'todoo)

(defcustom todoo-initials  (or (getenv "INITIALS") (user-login-name))
  "*Signature to be used for assigning todo items to oneself."
  :type 'string
  :group 'todoo)

(defcustom todoo-item-marker  "*"
  "*String used to indicate an unassigned item."
  :type 'string
  :group 'todoo)

(defcustom todoo-sub-item-marker  "-"
  "*String used to indicate a sub-item."
  :type 'string
  :group 'todoo)

(defcustom todoo-item-marker-assigned  "o"
  "*String used to indicate an assigned item."
  :type 'string
  :group 'todoo)

(defcustom todoo-file-name "~/.todo"
  "*Default todo file opened by 'todoo-show'."
  :type 'file
  :group 'todoo)

(defcustom todoo-file-template (concat 
				"This is a sample todo list.\n\n"
				"* Sample item\n"
				"  This is a simple item\n\n"
				"  - Sub item\n"
				"    This is a sample sub-item\n\n")
  "*Template for creating the todo file ."
  :type 'string
  :group 'todoo)

(defcustom todoo-item-header-face 'todoo-item-header-face
  "Specify face used for unassigned items"
  :type 'face
  :group 'todoo)

(defcustom todoo-sub-item-header-face 'todoo-sub-item-header-face
  "Specify face used for sub-items"
  :type 'face
  :group 'todoo)

(defcustom todoo-item-assigned-header-face 'todoo-item-assigned-header-face
  "Specify face used for assigned items "
  :type 'face
  :group 'todoo)


;;; Faces:

(defface todoo-item-header-face 
     '((t (:foreground "goldenrod" :bold t)))
   "Todoo-item unassigned header face")

(defface todoo-sub-item-header-face 
     '((t (:foreground "darkgoldenrod" :normal t)))
   "Todoo-sub-item header face")

(defface todoo-item-assigned-header-face 
     '((t (:foreground "red" :bold t)))
   "Todoo-item assigned header face")


;;; Variables:

(defvar todoo-font-lock-keywords 
  (list
   (list (concat "^[ ]*" (regexp-quote todoo-item-marker) " .*$") 
	 0 'todoo-item-header-face t)
   (list (concat "^[ ]*" (regexp-quote todoo-sub-item-marker) " .*$") 
	 0 'todoo-sub-item-header-face t)
   (list (concat "^[ ]*" (regexp-quote todoo-item-marker-assigned) 
		 " \\[.*\\] .*$") 
	 0 'todoo-item-assigned-header-face t))
  "Fontlocking for 'todoo-mode'.")


;; Keymap
(defvar todoo-mode-map nil "'todoo-mode' keymap.")
(if (not todoo-mode-map)
  (let ((map (make-keymap)))
    (define-key map "\C-c\C-s" 'todoo-save-and-exit)
    (define-key map "\C-c\C-b" 'todoo-assign-item)
    (define-key map "\C-c\C-d" 'todoo-unassign-item)
    (define-key map "\C-c\C-v" 'todoo-assign-item-to-self)
    (define-key map "\C-c\C-k" 'todoo-delete-item)
    (define-key map "\C-c\C-i" 'todoo-insert-item)
    (define-key map "\C-c\M-i" 'todoo-insert-sub-item)
    (define-key map "\C-c\C-t" 'hide-body)
    (define-key map "\C-c\C-a" 'show-all)
    (define-key map "\C-c\C-c" 'todoo-hide-item)
    (define-key map "\C-c\C-e" 'todoo-show-item)
    (define-key map "\C-c\C-p" 'outline-previous-visible-heading)
    (define-key map "\C-c\C-n" 'outline-next-visible-heading)
    (define-key map "\C-c\M-p" 'todoo-raise-item)
    (define-key map "\C-c\M-n" 'todoo-lower-item)
    (define-key map [C-up] 'outline-previous-visible-heading)
    (define-key map [C-down] 'outline-next-visible-heading)
    (define-key map [C-S-up] 'todoo-raise-item)
    (define-key map [C-S-down] 'todoo-lower-item)
    (setq todoo-mode-map map)))

;; Menu
(easy-menu-define todoo-menu todoo-mode-map 
"'todoo-mode' menu"
                  '("Todoo"
		    ["Insert item" todoo-insert-item t]
		    ["Insert sub-item" todoo-insert-sub-item t]
                    ["Kill item" todoo-delete-item t]
		    "---"
                    ["Assign item to self" todoo-assign-item-to-self t]
                    ["Assign item to other" todoo-assign-item t]
                    ["Unassign item" todoo-unassign-item t]
                    "---"
                    ["Hide all"	hide-body t]
                    ["Show all" show-all t]
                    ["Hide item" todoo-hide-item t]
                    ["Show item" todoo-show-item t]
                    "---"
                    ["Raise item" todoo-raise-item t]
                    ["Lower item" todoo-lower-item t]
                    "---"
                    ["Customize" (customize-group "todoo") t]
                    "---"
                    ["Save and exit todoo-mode" todoo-save-and-exit t]
                    ))

;; Add todoo to the tools menubar
(define-key global-map [menu-bar tools nil] '("----" . nil))
(define-key global-map [menu-bar tools todoo] '("Todoo" . todoo))


(if (not (fboundp 'point-at-bol))
    (defsubst point-at-bol () "Return value of point at beginning of line."
      (save-excursion
       (beginning-of-line)
        (point))))


(if (not (fboundp 'point-at-eol))
    (defsubst point-at-eol () "Return value of point at end of line."
      (save-excursion
        (end-of-line)
        (point))))


(defsubst todoo-item-marker-regexp ()
  "Regexp for matching markers. Created from 'todoo-item-marker' and
'todoo-item-marker-assigned'"
  (concat "^\\(" (regexp-quote todoo-item-marker) "\\|"
	  (regexp-quote todoo-item-marker-assigned) "\\) "))



(defun todoo-delete-item (&optional delete) 
  "Delete the current todoo-item. If DELETE is not nil, delete without
asking."
  (interactive "P")
  (if (> (count-lines (point-min) (point-max)) 0)
      (if (or delete (y-or-n-p "Remove item? "))
	  (progn 
	    (delete-region (todoo-item-start) (- (todoo-item-end) 1))
	    (message "Item removed"))
	(error "No TODO list entry to delete"))))


(defun todoo-item-start () 
  "Return point at start of current todoo-item."
  (save-excursion
    (beginning-of-line)
    (if (not (looking-at (todoo-item-marker-regexp)))
        (search-backward-regexp (todoo-item-marker-regexp) nil t))
    (point)))


(defun todoo-item-end () 
  "Return point at end of current todoo-item."
  (save-excursion
    (end-of-line)
    (search-forward-regexp (todoo-item-marker-regexp) nil 'goto-end)
    (- (point) (if (eq (point) (point-max)) 0 2))))


(defun todoo-hide-item () 
  "Hide the body of a todoo-item."
  (interactive)
  (save-excursion
    (goto-char (todoo-item-start))
    (hide-subtree)))


(defun todoo-show-item () 
  "Hide the body of a todoo-item."
  (interactive)
  (save-excursion
    (goto-char (todoo-item-start))
    (show-subtree)))


(defun todoo-assign-item (&optional user) 
  "Assign todoo-item to USER. If USER is nil, prompt for it."
  (interactive "sAssign item to: ")
  (if (and user (> (length user) 0))
      (save-excursion
	(beginning-of-line)
	(if (not (looking-at (todoo-item-marker-regexp)))
	    (search-backward-regexp (todoo-item-marker-regexp) nil t))
	(if (re-search-forward 
	     (concat "^" (regexp-quote todoo-item-marker) " ")
	     (todoo-item-end) t)
	       (replace-match 
		(concat todoo-item-marker-assigned " [" user "] ") nil nil)
	  (if (re-search-forward 
	       (concat "^" todoo-item-marker-assigned " \\[.*\\] ")
	       (todoo-item-end) t)
	         (replace-match 
		  (concat todoo-item-marker-assigned " [" user "] ") 
		  nil nil))))))


(defun todoo-assign-item-to-self () 
  "Assign todoo-item to self, using 'todo-initials' as name."
  (interactive)
  (todoo-assign-item todoo-initials))


(defun todoo-unassign-item () 
  "Make todoo-item unassigned."
  (interactive "")
  (save-excursion
    (beginning-of-line)
    (if (not (looking-at (todoo-item-marker-regexp)))
	(search-backward-regexp (todoo-item-marker-regexp) nil t))
      (if (re-search-forward
	   (concat "^" todoo-item-marker-assigned " \\[.*\\]")
	   (todoo-item-end) t)
	      (replace-match "*" nil nil)
	(message "Item is already unassigned."))))


(defun todoo-raise-item () 
  "Raise todoo-item."
  (interactive)
  (kill-region (todoo-item-start) (todoo-item-end))
  (search-backward-regexp (todoo-item-marker-regexp) nil t)
  (yank)
  (search-backward-regexp (todoo-item-marker-regexp) nil t))


(defun todoo-lower-item () 
  "Lower todoo-item."
  (interactive)
    (kill-region (todoo-item-start) (todoo-item-end))
    (if (search-forward-regexp (todoo-item-marker-regexp) nil 'goto-end 2)
	(backward-char 2)
      (end-of-buffer))
    (yank)
    (search-backward-regexp  (todoo-item-marker-regexp) nil t))


(defun todoo-insert-item () 
  "Insert a new todoo-item."
  (interactive)
  (goto-char (- (todoo-item-end) 1))
  (insert "\n" todoo-item-marker " \n")
  (backward-char))


(defun todoo-insert-sub-item () 
  "Insert a new todoo-sub-item."
  (interactive)
  (goto-char (- (todoo-item-end) 1))
  (insert (concat "\n" (make-string (* (- (outline-font-lock-level) 2)
			       todoo-indent-column) ? )
		  todoo-sub-item-marker " \n"))
  (backward-char))


(defun todoo-indent-line ()
  "Indent a line properly according to 'todoo-mode'."
  (interactive)
  (beginning-of-line)

  (let ((indent-column (* (- (outline-font-lock-level) 1)
			  todoo-indent-column)))
    (if (eq (point) (point-at-eol))
	(insert (make-string indent-column ? )))
    (if (re-search-forward (concat "^[ ]*\\(" todoo-item-marker
				   "\\|" todoo-item-marker-assigned
				   "\\|" todoo-sub-item-marker
				   "\\)") (point-at-eol) t)
	(replace-match (concat (make-string (- indent-column
					       todoo-indent-column) ? ) "\\1")
		       nil nil)
      (if (re-search-forward "^[ ]*" (point-at-eol) t)
	  (replace-match (make-string indent-column ? )
			 nil nil)))))
  

(defun todoo-save-and-exit ()
  "If 'todoo-file' is open, save and kill its buffer and delete any window
that was created in 'todoo-show'. If 'todoo-file' is not open, save and kill
the current buffer if it is in 'todoo-mode'."
  (interactive)
  (let ((todoo-buffer (or (find-buffer-visiting
			   (substitute-in-file-name todoo-file-name))
			  (if (eq major-mode 'todoo-mode)
			      (current-buffer)))))
    (if todoo-buffer
	(progn
	  (set-buffer todoo-buffer)
	  (save-buffer)
	  ; Delete window if created by todoo-show and still visible
	  (if (and (window-live-p todoo-show-created-window) 
		   (< 1 (count-windows)))
	      (delete-window todoo-show-created-window))
	  (kill-buffer todoo-buffer))
      (error "Todoo-mode not active"))))


(defun todoo-insert-template ()
  "Insert 'todoo-file-template' template into the current buffer."
  (beginning-of-buffer)
  (insert todoo-file-template))


(defun todoo-find-file-noselect (filename)
  "Open FILENAME without selecting its buffer, create it with a template
from 'todoo-insert-template' if necessary. Returns the buffer."
  (if (file-exists-p filename)
      (if (file-readable-p filename)
	  (find-file-noselect filename t)
	(error "Todoo-file not readable."))
    (let ((tbuf (find-file-noselect filename t)))
      (save-excursion
	(set-buffer tbuf)
	(todoo-insert-template))
      (message "Todoo-file '%s' created." filename) 
      tbuf)))


(defun todoo-show (filename) 
  "Open 'todoo-file-name' in 'todoo-mode'."
  (message "%s" filename)
  (let ((todoo-buffer (find-buffer-visiting filename))
	(wincount (count-windows)))
    (if (not todoo-buffer)
	(setq todoo-buffer (todoo-find-file-noselect filename))
	(set-buffer todoo-buffer)
	(or (verify-visited-file-modtime todoo-buffer)
	    (revert-buffer t t)))
    (if todoo-show-pop-up-window
	(pop-to-buffer todoo-buffer nil)
      (switch-to-buffer todoo-buffer))
    (todoo-mode)
    ;: Did we cause a new window?
    (if (< wincount (count-windows))
	(if (boundp 'todoo-show-created-window)
	    (setq todoo-show-created-window (get-buffer-window
					     todoo-buffer))
	  (error "Not in todoo-mode.")))))


(defun todoo (&optional prompt)
  "Interactive function for viewing a todo-file. If prefix arg PROMPT is
not NIL the user will be asked for a filename."
  (interactive "P")
  (let ((tfile (if prompt
		   (read-file-name "Todo-file: ")
		 (substitute-in-file-name todoo-file-name))))
    (todoo-show tfile)))



(defun todoo-mode () 
  "Todoo-mode is a major mode for editing lists of
todo-items in an 'outline-mode' fashion.\n\n\\{todoo-mode-map}"
  (interactive)
  (kill-all-local-variables)

  (setq major-mode 'todoo-mode)
  (setq mode-name "Todoo")

  (use-local-map todoo-mode-map)
  (easy-menu-add todoo-menu)

  ;; Keep track of window creation when doing a pop up
  (make-local-variable 'todoo-show-created-window)
  (setq todoo-show-created-window nil)

  (make-local-variable 'paragraph-start)
  (setq paragraph-start (todoo-item-marker-regexp))

  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate paragraph-start)

  (set-syntax-table text-mode-syntax-table)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(todoo-font-lock-keywords t))

  (setq outline-regexp (concat "^\\(" (regexp-quote todoo-item-marker) " \\|"
			       (regexp-quote todoo-item-marker-assigned) 
			       " \\|[ ]*" (regexp-quote todoo-sub-item-marker)
			       " \\)"))

  (outline-minor-mode 1)

  (define-key outline-mode-menu-bar-map [headings] 'undefined)
  (define-key outline-mode-menu-bar-map [hide] 'undefined)
  (define-key outline-mode-menu-bar-map [show] 'undefined)

  (if todoo-collapse-items
      (hide-body))

  ; Custom indentation handling
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'todoo-indent-line)

  (setq fill-prefix (make-string todoo-indent-column ? ))
  (auto-fill-mode 1)

  ; Advertise how to leave todoo-mode
  (let* ((keys (where-is-internal 'todoo-save-and-exit
				  overriding-local-map nil nil))
	 (keys1 (mapconcat 'key-description keys ", ")))
    (if (> (length keys1) 0)
	(message "%s saves and exits todoo" keys1)))

  (setq mode-popup-menu
	'todoo-menu)

  (run-hooks 'todoo-mode-hook))


(provide 'todoo)
;;; todoo.el ends here

emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/protocols.el0000775000000000000000000001370412230377265021621 0ustar  ;;; protocols.el --- Protocol database access functions.
;; Copyright 2000-2008 by Dave Pearson 
;; $Revision: 1.4 $

;; protocols.el is free software distributed under the terms of the GNU
;; General Public Licence, version 2 or (at your option) any later version.
;; For details see the file COPYING.

;;; Commentary:
;;
;; protocols.el provides a set of functions for accessing the protocol
;; details list.
;;
;; The latest protocols.el is always available from:
;;
;;   

;;; BUGS:
;;
;; o Large parts of this code look like large parts of the code you'll find
;;   in services.el, this is unfortunate and makes me cringe. However, I
;;   also wanted them to be totally independant of each other. Suggestions
;;   of how to sweetly remedy this situation are welcome.

;;; INSTALLATION:
;;
;; o Drop protocols.el somwehere into your `load-path'. Try your site-lisp
;;   directory for example (you might also want to byte-compile the file).
;;
;; o Add the following autoload statement to your ~/.emacs file:
;;
;;   (autoload 'protocols-lookup      "protocols" "Perform a protocol lookup" t)
;;   (autoload 'protocols-clear-cache "protocols" "Clear the protocols cache" t)

;;; Code:

;; Things we need:

(eval-when-compile
  (require 'cl))

;; Attempt to handle older/other emacs.

(eval-and-compile
  
  ;; If `line-beginning-position' isn't available provide one.
  (unless (fboundp 'line-beginning-position)
    (defun line-beginning-position (&optional n)
      "Return the `point' of the beginning of the current line."
      (save-excursion
        (beginning-of-line n)
        (point))))

  ;; If `line-end-position' isn't available provide one.
  (unless (fboundp 'line-end-position)
    (defun line-end-position (&optional n)
      "Return the `point' of the end of the current line."
      (save-excursion
        (end-of-line n)
        (point)))))

;; Customisable variables.

(defvar protocols-file "/etc/protocols"
  "*Name of the protocols file.")

;; Non-customize variables.

(defvar protocols-cache nil
  "\"Cache\" of protocols.")

(defvar protocols-name-cache nil
  "\"Cache\" of protocol names.")

;; Main code.

(defsubst proto-name (proto)
  "Return the name of protocol PROTO."
  (car proto))

(defsubst proto-number (proto)
  "Return the number of protocol PROTO."
  (cadr proto))

(defsubst proto-aliases (proto)
  "Return the alias list of protocol PROTO."
  (cadr (cdr proto)))

(defun protocols-line-to-list (line)
  "Convert LINE from a string into a structured protocol list."
  (let ((words (split-string line)))
    (list
     (car words)
     (string-to-int (cadr words))
     (loop for s in (cddr words)
           while (not (= (aref s 0) ?#))
           collect s))))

(defun* protocols-read (&optional (file protocols-file))
  "Read the protocol list from FILE.

If FILE isn't supplied the value of `protocols-file' is used."
  (or protocols-cache
      (setq protocols-cache (when (file-readable-p file)
                              (with-temp-buffer
                                (insert-file-contents file)
                                (setf (point) (point-min))
                                (loop until (eobp)
                                      do (setf (point) (line-beginning-position))
                                      unless (or (looking-at "^[ \t]*#") (looking-at "^[ \t]*$"))
                                      collect (protocols-line-to-list (buffer-substring (line-beginning-position) (line-end-position)))
                                      do (forward-line)))))))

(defun* protocols-find-by-name (name &optional (protocols (protocols-read)))
  "Find the protocol whose name is NAME."
  (assoc name protocols))

(defun* protocols-find-by-number (number &optional (protocols (protocols-read)))
  "Find the protocol whose number is NUMBER."
  (loop for protocol in protocols
        when (= (proto-number protocol) number) return protocol))

(defun* protocols-find-by-alias (alias  &optional (protocols (protocols-read)))
  "Find the protocol that has an alias of ALIAS."
  (loop for protocol in protocols
        when (member alias (proto-aliases protocol)) return protocol))

;;;###autoload
(defun protocols-lookup (search)
  "Find a protocol and display its details."
  (interactive (list
                (completing-read "Protocol search: "
                                 (or protocols-name-cache
                                     (setq protocols-name-cache
                                           (loop for protocol in (protocols-read)
                                                 collect (list (proto-name protocol))
                                                 append (loop for alias in (proto-aliases protocol)
                                                              collect (list alias))))))))
  (let* ((protocols (protocols-read))
         (protocol (or (when (string-match "^[0-9]+$" search)
                         (protocols-find-by-number (string-to-int search) protocols))
                       (protocols-find-by-name search protocols)
                       (protocols-find-by-name (downcase search) protocols)
                       (protocols-find-by-name (upcase search) protocols)
                       (protocols-find-by-alias search protocols)
                       (protocols-find-by-alias (downcase search) protocols)
                       (protocols-find-by-alias (upcase search) protocols))))
    (if protocol
        (message "Protocol: %s  ID: %d  Aliases: %s"
                 (proto-name protocol)
                 (proto-number protocol)
                 (with-output-to-string
                     (loop for alias in (proto-aliases protocol)
                           do (princ alias) (princ " "))))
      (error "Can't find a protocol matching \"%s\"" search))))

;;;###autoload
(defun protocols-clear-cache ()
  "Clear the protocols \"cache\"."
  (interactive)
  (setq protocols-cache      nil
        protocols-name-cache nil))

(provide 'protocols)

;;; protocols.el ends here.
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/bm.el0000775000000000000000000012723212230377265020175 0ustar  ;;; bm.el  --- Visible bookmarks in buffer.

;; Copyrigth (C) 2000-2010  Jo Odland

;; Author: Jo Odland 
;; Version: $Id: bm.el,v 1.2 2010-05-05 13:27:50 psg Exp $
;; Keywords; bookmark, highlight, faces, persistent
;; URL: http://www.nongnu.org/bm/
;; Project page: https://savannah.nongnu.org/projects/bm/

;; Portions Copyright (C) 2002 by Ben Key
;; Updated by Ben Key  on 2002-12-05
;; to add support for XEmacs


;; This file is *NOT* part of GNU Emacs.

;; 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 2, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.


;;; Commentary:

;;; Description:
;;
;;   This package was created because I missed the bookmarks from M$
;;   Visual Studio. I find that they provide an easy way to navigate
;;   in a buffer.
;;
;;   bm.el provides visible, buffer local, bookmarks and the ability
;;   to jump forward and backward to the next bookmark.
;;
;;   Features:
;;    - Toggle bookmarks with `bm-toggle' and navigate forward and
;;      backward in buffer with `bm-next' and `bm-previous'.
;;
;;    - Different wrapping modes, see `bm-wrap-search' and `bm-wrap-immediately'.
;;      Use `bm-toggle-wrapping' to turn wrapping on/off. Wrapping is only available
;;      when `bm-cycle-all-buffers' is nil.
;;
;;    - Navigate between bookmarks only in current buffer or cycle through all buffers.
;;      Use `bm-cycle-all-buffers' to enable looking for bookmarks across all open buffers.
;;      When cycling through bookmarks in all open buffers, the search will always wrap around.
;;
;;    - Setting bookmarks based on a regexp, see `bm-bookmark-regexp' and
;;      `bm-bookmark-regexp-region'.
;;
;;    - Setting bookmark based on line number, see `bm-bookmark-line'.
;;
;;    - Goto line position or start of line, see `bm-goto-position'.
;;
;;    - Persistent bookmarks (see below). Use `bm-toggle-buffer-persistence'
;;      to enable/disable persistent bookmarks (buffer local).
;;
;;    - List bookmarks with annotations and context in a separate buffer,
;;      see `bm-show' (current buffer) and `bm-show-all' (all buffers).
;;
;;    - Remove all bookmarks in current buffer with `bm-remove-all-current-buffer' and
;;      all bookmarks in all open buffers with `bm-remove-all-all-buffers'.
;;
;;    - Annotate bookmarks, see `bm-bookmark-annotate' and `bm-bookmark-show-annotation'.
;;      The annotation is displayed in the messsage area when navigating to a bookmark.
;;      Set the variable `bm-annotate-on-create' to t to be prompted for an annotation
;;      when bookmark is created.
;;
;;    - Different bookmark styles, fringe-only, line-only or both,
;;      see `bm-highlight-style'. It is possible to have fringe-markers on left or right side.
;;


;;; Known limitations:
;;
;;   This package is developed and testet on GNU Emacs 22.x. It should
;;   work on all GNU Emacs 21.x, GNU Emacs 23.x and also on XEmacs
;;   21.x with some limitations.
;;
;;   There are some incompabilities with lazy-lock when using
;;   fill-paragraph. All bookmark below the paragraph being filled
;;   will be lost. This issue can be resolved using the `jit-lock-mode'
;;   introduced in GNU Emacs 21.1
;;


;;; Installation:
;;
;;   To use bm.el, put it in your load-path and add
;;   the following to your .emacs
;;
;;   (require 'bm)
;;
;; or
;;
;;   (autoload 'bm-toggle   "bm" "Toggle bookmark in current buffer." t)
;;   (autoload 'bm-next     "bm" "Goto bookmark."                     t)
;;   (autoload 'bm-previous "bm" "Goto previous bookmark."            t)
;;


;;; Configuration:
;;
;;   To make it easier to use, assign the commands to some keys.
;;
;;   M$ Visual Studio key setup.
;;     (global-set-key (kbd "") 'bm-toggle)
;;     (global-set-key (kbd "")   'bm-next)
;;     (global-set-key (kbd "") 'bm-previous)
;;
;;   Click on fringe to toggle bookmarks, and use mouse wheel to move
;;   between them.
;;     (global-set-key (kbd " ") 'bm-next-mouse)
;;     (global-set-key (kbd " ") 'bm-previous-mouse)
;;     (global-set-key (kbd " ") 'bm-toggle-mouse)
;;
;;   If you would like the markers on the right fringe instead of the
;;   left, add the following to line:
;;
;;   (setq bm-marker 'bm-marker-right)
;;



;;; Persistence:
;;
;;   Bookmark persistence is achieved by storing bookmark data in a
;;   repository when a buffer is killed. The repository is saved to
;;   disk on exit. See `bm-repository-file'. The maximum size of the
;;   repository is controlled by `bm-repository-size'.
;;
;;   The buffer local variable `bm-buffer-persistence' decides if
;;   bookmarks in a buffer is persistent or not. Non-file buffers
;;   can't have persistent bookmarks, except for *info* and
;;   indirect buffers.
;;
;;   Bookmarks are non-persistent as default. To have bookmarks
;;   persistent as default add the following line to .emacs.
;;
;;   ;; make bookmarks persistent as default
;;   (setq-default bm-buffer-persistence t)

;;   Use the function `bm-toggle-buffer-persistence' to toggle
;;   bookmark persistence.
;;
;;   To have automagic bookmark persistence we need to add some
;;   functions to the following hooks. Insert the following code
;;   into your .emacs file:
;;
;;   If you are using desktop or other packages that restore buffers
;;   on start up, bookmarks will not be restored. When using
;;   `after-init-hook' to restore the repository, it will be restored
;;   *after* .emacs is finished. To load the repository when bm is
;;   loaded set the variable `bm-restore-repository-on-load' to t,
;;   *before* loading bm (and don't use the `after-init-hook').
;;
;;   ;; Make sure the repository is loaded as early as possible
;;   (setq bm-restore-repository-on-load t)
;;   (require 'bm)
;;
;;   ;; Loading the repository from file when on start up.
;;   (add-hook' after-init-hook 'bm-repository-load)
;;
;;   ;; Restoring bookmarks when on file find.
;;   (add-hook 'find-file-hooks 'bm-buffer-restore)
;;
;;   ;; Saving bookmark data on killing a buffer
;;   (add-hook 'kill-buffer-hook 'bm-buffer-save)
;;
;;   ;; Saving the repository to file when on exit.
;;   ;; kill-buffer-hook is not called when Emacs is killed, so we
;;   ;; must save all bookmarks first.
;;   (add-hook 'kill-emacs-hook '(lambda nil
;; 	  		             (bm-buffer-save-all)
;; 			             (bm-repository-save)))
;;
;;   ;; Update bookmark repository when saving the file.
;;   (add-hook 'after-save-hook 'bm-buffer-save)
;;
;;   ;; Restore bookmarks when buffer is reverted.
;;   (add-hook 'after-revert-hook 'bm-buffer-restore)
;;
;;
;;   The `after-save-hook' and `after-revert-hook' is not necessary to
;;   use to achieve persistence, but it makes the bookmark data in
;;   repository more in sync with the file state.
;;
;;   The `after-revert-hook' might cause trouble when using packages
;;   that automatically reverts the buffer (like vc after a check-in).
;;   This can easily be avoided if the package provides a hook that is
;;   called before the buffer is reverted (like `vc-before-checkin-hook').
;;   Then new bookmarks can be saved before the buffer is reverted.
;;
;;   ;; make sure bookmarks is saved before check-in (and revert-buffer)
;;   (add-hook 'vc-before-checkin-hook 'bm-buffer-save)



;;; Acknowledgements:
;;
;;  - The use of overlays for bookmarks was inspired by highline.el by
;;    Vinicius Jose Latorre .
;;  - Thanks to Ben Key for XEmacs support.
;;  - Thanks to Peter Heslin for notifying me on the incompability with
;;    lazy-lock.
;;  - Thanks to Christoph Conrad for adding support for goto line position
;;    in bookmarks and simpler wrapping.
;;  - Thanks to Jan Rehders for adding support for different bookmark styles.
;;  - Thanks to Dan McKinley  for inspiration to add support
;;    for listing bookmarks in all buffers, `bm-show-all'.
;;    (http://www.emacswiki.org/cgi-bin/wiki/bm-ext.el)
;;  - Thanks to Jonathan Kotta  for mouse support and fringe
;;    markers on left or right side.


;;; Change log:

;;  Changes in 1.43
;;   - Fixed spelling. Thanks to Juanma Barranquero  for patch.
;;
;;  Changes in 1.42
;;   - Fixed bug(#29536) - Next/previous does not wrap when `bm-cycle-all-buffers' t
;;     and only bookmarks in one buffer.
;;
;;  Changes in 1.41
;;   - Updated documentation to satisfy `checkdoc'.
;;
;;  Changes in 1.38
;;   - Added support for bookmark search across buffers. See `bm-cycle-all-buffers'.
;;   - Added support for mouse navigation (#28863). See `bm-toggle-mouse', `bm-next-mouse'
;;     and `bm-previous-mouse'.
;;   - Added support for markers on the right fringe (#28863).
;;
;;  Changes in 1.36
;;   - Added support for persistent bookmarks in non-file buffers (Info buffers, indirect-buffers).
;;   - Fixed bug(#26077) - bm asks for annotation when restoring bookmarks for bookmarks which
;;     already have an annotation.
;;
;;  Changes in 1.35
;;   - Added utf-8 encoding on `bm-repository-file'
;;   - Removed compile check on fringe support.
;;
;;  Changes in 1.34
;;   - Added support for bookmarks in fringe (Patch from Jan Rehders )
;;   - Fixed bugs with `bm-next', `bm-previous' and `bm-goto'.
;;   - Removed line format variables, `bm-show-header-string' and `bm-show-format-string'.
;;   - Added `bm-show-all' for displaying bookmarks in all buffers.
;;
;;  Changes in 1.32
;;   - Added change log.
;;
;;  Changes in 1.31
;;   - Renamed function `bm-extract' to `bm-show'
;;   - Fixed annotation bug in `bm-bookmark-regexp-region'.
;;
;;  Changes in 1.30
;;   - New format on file repository.
;;   - Support for annotation of bookmarks. See variable `bm-annotate-on-create',
;;     `bm-bookmark-annotate' and `bm-bookmark-show-annotation'.
;;   - Added context to help restoring bookmarks correctly,
;;     see `bm-bookmark-context-size'.
;;   - Renamed function `bm-repository-empty' to `bm-repositoty-clear'.
;;


;;; Todo:
;;
;;  - Prevent the bookmark (overlay) from being extended when
;;    inserting (before, inside or after) the bookmark in XEmacs. This
;;    is due to the missing support for overlay hooks i XEmacs.
;;


;;; Code:
;;

(eval-and-compile
  ;; avoid compile waring on unbound variable
  (require 'info)

  ;; xemacs needs overlay emulation package
  (unless (fboundp 'overlay-lists)
    (require 'overlay)))


(defconst bm-version "$Id: bm.el,v 1.2 2010-05-05 13:27:50 psg Exp $"
  "CVS version of bm.el.")

(defconst bm-bookmark-repository-version 2
  "The repository version.")

(defgroup bm nil
  "Visible, buffer local bookmarks."
  :link '(emacs-library-link :tag "Source Lisp File" "bm.el")
  :group 'faces
  :group 'editing
  :prefix "bm-")

(defcustom bm-highlight-style 'bm-highlight-only-line
  "*Specify how bookmars are highlighted."
  :type '(choice (const bm-highlight-only-line)
                 (const bm-highlight-only-fringe)
                 (const bm-highlight-line-and-fringe))
  :group 'bm)

(defcustom bm-face 'bm-face
  "*Specify face used to highlight the current line."
  :type 'face
  :group 'bm)


(defcustom bm-persistent-face 'bm-persistent-face
  "*Specify face used to highlight the current line for persistent bookmarks."
  :type 'face
  :group 'bm)

(defcustom bm-priority 0
  "*Specify bm overlay priority.

Higher integer means higher priority, so bm overlay will have precedence
over overlays with lower priority.  *Don't* use negative number."
  :type 'integer
  :group 'bm)


(defface bm-face
  '((((class grayscale)
      (background light)) (:background "DimGray"))
    (((class grayscale)
      (background dark))  (:background "LightGray"))
    (((class color)
      (background light)) (:foreground "White" :background "DarkOrange1"))
    (((class color)
      (background dark))  (:foreground "Black" :background "DarkOrange1")))
  "Face used to highlight current line."
  :group 'bm)


(defface bm-persistent-face
  '((((class grayscale)
      (background light)) (:background "DimGray"))
    (((class grayscale)
      (background dark))  (:background "LightGray"))
    (((class color)
      (background light)) (:foreground "White" :background "DarkBlue"))
    (((class color)
      (background dark))  (:foreground "White" :background "DarkBlue")))
  "Face used to highlight current line if bookmark is persistent."
  :group 'bm)


(defcustom bm-fringe-face 'bm-fringe-face
  "*Specify face used to highlight the fringe."
  :type 'face
  :group 'bm)

(defcustom bm-fringe-persistent-face 'bm-fringe-persistent-face
  "*Specify face used to highlight the fringe for persistent bookmarks."
  :type 'face
  :group 'bm)

(defface bm-fringe-face
  '((((class grayscale)
      (background light)) (:background "DimGray"))
    (((class grayscale)
      (background dark))  (:background "LightGray"))
    (((class color)
      (background light)) (:foreground "White" :background "DarkOrange1"))
    (((class color)
      (background dark))  (:foreground "Black" :background "DarkOrange1")))
  "Face used to highlight bookmarks in the fringe."
  :group 'bm)

(defface bm-fringe-persistent-face
  '((((class grayscale)
      (background light)) (:background "DimGray"))
    (((class grayscale)
      (background dark))  (:background "LightGray"))
    (((class color)
      (background light)) (:foreground "White" :background "DarkBlue"))
    (((class color)
      (background dark))  (:foreground "White" :background "DarkBlue")))
  "Face used to highlight bookmarks in the fringe if bookmark is persistent."
  :group 'bm)


(defcustom bm-annotate-on-create nil
  "*Specify if bookmarks must be annotated when created.

nil, don't ask for an annotation when creating a bookmark.
t, always ask for annotation when creating a bookmark."
  :type 'boolean
  :group 'bm)


(defcustom bm-wrap-search t
 "*Specify if bookmark search should wrap.

nil, don't wrap when there are no more bookmarks.
t, wrap."
 :type 'boolean
 :group 'bm)


(defcustom bm-wrap-immediately t
  "*Specify if a wrap should be announced or not.
Only has effect when `bm-wrap-search' is t.

nil, announce before wrapping.
t, don't announce."
  :type 'boolean
  :group 'bm)

(defcustom bm-cycle-all-buffers nil
 "*Specify if bookmark search is done across buffers.
This will ignore the `bm-wrap-search' setting.

nil, only search in current buffer.
t, search in all open buffers."
 :type 'boolean
 :group 'bm)

(defcustom bm-recenter nil
  "*Specify if the buffer should be recentered after jumping to a bookmark."
  :type 'boolean
  :group 'bm)


(defcustom bm-goto-position t
  "*Specify the position, on line, to go to when jumping to a bookmark.

nil, goto start of line.
t, goto position on the line where the bookmark was set."
  :type 'boolean
  :group 'bm)


(defcustom bm-repository-file (expand-file-name "~/.bm-repository")
  "*Filename to store persistent bookmarks across sessions.

nil, the repository will not be persistent."
  :type 'string
  :group 'bm)


(defcustom bm-repository-size 100
  "*Size of persistent repository. If nil then there if no limit."
  :type 'integer
  :group 'bm)


(defcustom bm-buffer-persistence nil
  "*Specify if bookmarks in a buffer should be persistent.
Buffer local variable.

nil, don't save bookmarks.
t, save bookmarks."
  :type 'boolean
  :group 'bm)
(make-variable-buffer-local 'bm-buffer-persistence)


(defcustom bm-restore-on-mismatch nil
  "*Specify if bookmarks should be restored if there is a buffer size mismatch.
DEPRECATED: Only in use for version 1 of repository.

nil, don't restore.
t, restore if possible."
  :type 'boolean
  :group 'bm)


(defvar bm-restore-repository-on-load nil
  "Specify if repository should be restored when loading bm.

nil, don't restore repository on load.
t, restore repository when this file is loaded. This must be set
before bm is loaded.")

(defvar bm-repository nil
  "Alist with all persistent bookmark data.")

(defvar bm-regexp-history nil
  "Bookmark regexp history.")

(defvar bm-annotation-history nil
  "Bookmark annotation history.")

(defvar bm-bookmark-context-size 16
  "The size of context stored, before and after, for each bookmark.")

(defvar bm-wrapped nil
  "State variable to support wrapping.")
(make-variable-buffer-local 'bm-wrapped)

(defvar bm-marker 'bm-marker-left
  "Fringe marker side. Left of right.")

(define-fringe-bitmap 'bm-marker-left   [#x00 #x00 #xFC #xFE #x0F #xFE #xFC #x00])
(define-fringe-bitmap 'bm-marker-right  [#x00 #x00 #x3F #x7F #xF0 #x7F #x3F #x00])


(defun bm-customize nil
  "Customize bm group."
  (interactive)
  (customize-group 'bm))


(defun bm-bookmark-annotate (&optional bookmark annotation)
  "Annotate bookmark at point or the BOOKMARK specified as parameter.

If ANNOTATION is provided use this, and not prompt for input."
  (interactive)
  (if (null bookmark)
      (setq bookmark (bm-bookmark-at (point))))

  (if (bm-bookmarkp bookmark)
      (progn
        (if (null annotation)
            (setq annotation (read-from-minibuffer "Annotation: " nil nil nil 'bm-annotation-history)))
        (overlay-put bookmark 'annotation annotation))    (if (interactive-p) (message "No bookmark at point"))))
    

(defun bm-bookmark-show-annotation (&optional bookmark)
  "Show annotation for bookmark.
Either the bookmark at point or the BOOKMARK specified as parameter."
  (interactive)
  (if (null bookmark)
      (setq bookmark (bm-bookmark-at (point))))

  (if (bm-bookmarkp bookmark)
      (progn
        (let ((annotation (overlay-get bookmark 'annotation)))
          (if annotation
              (message annotation)
            (message "No annotation for current bookmark."))))
    (message "No bookmark at current line.")))

(defun bm-line-highlighted ()
  "Test if line is highlighted."
  (or (equal bm-highlight-style 'bm-highlight-only-line)
      (equal bm-highlight-style 'bm-highlight-line-and-fringe)))

(defun bm-fringe-highlighted ()
  "Test if fringe is highlighted."
  (or (equal bm-highlight-style 'bm-highlight-only-fringe)
      (equal bm-highlight-style 'bm-highlight-line-and-fringe)))

(defun bm-bookmark-add (&optional annotation)
  "Add bookmark at current line.

If ANNOTATION is provided use this, and do not prompt for input.
Only used if `bm-annotate-on-create' is true.

Do nothing if bookmark is present."
  (if (bm-bookmark-at (point))
      nil				; bookmark exists
    (let ((bookmark (make-overlay (bm-start-position) (bm-end-position)))
          (hlface (if bm-buffer-persistence bm-persistent-face bm-face))
          (hlface-fringe (if bm-buffer-persistence bm-fringe-persistent-face bm-fringe-face)))
      ;; set market
      (overlay-put bookmark 'position (point-marker))
      ;; select bookmark face
      (when (bm-line-highlighted)
        (overlay-put bookmark 'face hlface))
      (overlay-put bookmark 'evaporate t)
      (overlay-put bookmark 'category 'bm)
      (when (bm-fringe-highlighted)
        (let* ((marker-string "*fringe-dummy*")
               (marker-length (length marker-string)))
          (put-text-property 0 marker-length 'display
                             (list (if (eq bm-marker 'bm-marker-left)
                                       'left-fringe
                                     'right-fringe)
                                   bm-marker hlface-fringe)
                             marker-string)
          (overlay-put bookmark 'before-string marker-string)))
      (if (or bm-annotate-on-create annotation)
          (bm-bookmark-annotate bookmark annotation))
      (unless (featurep 'xemacs)
	;; gnu emacs specific features
	(overlay-put bookmark 'priority bm-priority)
	(overlay-put bookmark 'modification-hooks '(bm-freeze))
	(overlay-put bookmark 'insert-in-front-hooks '(bm-freeze-in-front))
	(overlay-put bookmark 'insert-behind-hooks '(bm-freeze)))
      bookmark)))


(defun bm-bookmark-remove (&optional bookmark)
  "Remove bookmark at point or the BOOKMARK specified as parameter."
  (if (null bookmark)
      (setq bookmark (bm-bookmark-at (point))))

  (if (bm-bookmarkp bookmark)
      (delete-overlay bookmark)))


;;;###autoload
(defun bm-toggle nil
  "Toggle bookmark at point."
  (interactive)
  (let ((bookmark (bm-bookmark-at (point))))
    (if bookmark
	(bm-bookmark-remove bookmark)
      (bm-bookmark-add))))


;;;###autoload
(defun bm-toggle-mouse (ev)
  "Toggle a bookmark with a mouse click.
EV is the mouse event."
  (interactive "e")
  (save-excursion
    (mouse-set-point ev)
    (bm-toggle)))


(defun bm-count nil
  "Count the number of bookmarks in buffer."
  (let ((bookmarks (bm-lists)))
    (+ (length (car bookmarks)) (length (cdr bookmarks)))))


(defun bm-start-position nil
  "Return the bookmark start position."
  (point-at-bol))


(defun bm-end-position nil
  "Return the bookmark end position."
  (min (point-max) (+ 1 (point-at-eol))))


(defun bm-freeze-in-front (overlay after begin end &optional len)
  "Prevent overlay from being extended to multiple lines.
When inserting in front of overlay move overlay forward.

OVERLAY the overlay being modified.
AFTER nil when called before, t when called after modification.
BEGIN the beginning of the text being modified.
END the end of the text being modified.
When called after, the length of the modification is passed as LEN.

See Overlay Properties in the Emacs manual for more information:
http://www.gnu.org/s/emacs/manual/html_node/elisp/Overlay-Properties.html"
  (if after
      (move-overlay overlay (bm-start-position) (bm-end-position))))


(defun bm-freeze (overlay after begin end &optional len)
  "Prevent OVERLAY from being extended to multiple lines.
When inserting inside or behind the overlay, keep the original start postion.

OVERLAY the overlay being modified.
AFTER nil when called before, t when called after modification.
BEGIN the beginning of the text being modified.
END the end of the text being modified.
When called after, the length of the modification is passed as LEN.

See Overlay Properties in the Emacs manual for more information:
http://www.gnu.org/s/emacs/manual/html_node/elisp/Overlay-Properties.html"
  (if after
      (let ((bm-start (overlay-start overlay)))
	(if bm-start
	    (move-overlay overlay
			  bm-start
			  (save-excursion
			    (goto-char bm-start)
			    (bm-end-position)))))))


(defun bm-equal (first second)
  "Compare two bookmarks. Return t if FIRST is equal to SECOND."
  (if (and (bm-bookmarkp first) (bm-bookmarkp second))
      (= (overlay-start first) (overlay-start second))
    nil))


(defun bm-bookmarkp (bookmark)
  "Return the BOOKMARK if overlay is a bookmark."
  (if (and (overlayp bookmark)
	   (string= (overlay-get bookmark 'category) "bm"))
      bookmark
    nil))


(defun bm-bookmark-at (point)
  "Get bookmark at POINT."
  (let ((overlays (overlays-at point))
	(bookmark nil))
    (while (and (not bookmark) overlays)
      (if (bm-bookmarkp (car overlays))
	  (setq bookmark (car overlays))
	(setq overlays (cdr overlays))))
    bookmark))


(defun bm-lists (&optional direction)
  "Return a pair of lists giving all the bookmarks of the current buffer.
The car has all the bookmarks before the overlay center;
the cdr has all the bookmarks after the overlay center.
A bookmark implementation of `overlay-list'.

If optional argument DIRECTION is provided, only return bookmarks
in the specified direction."
  (overlay-recenter (point))
  (cond ((equal 'forward direction)
         (cons nil (remq nil (mapcar 'bm-bookmarkp (cdr (overlay-lists))))))
        ((equal 'backward direction)
         (cons (remq nil (mapcar 'bm-bookmarkp (car (overlay-lists)))) nil))
        (t
         (cons (remq nil (mapcar 'bm-bookmarkp (car (overlay-lists))))
               (remq nil (mapcar 'bm-bookmarkp (cdr (overlay-lists))))))))


;;;###autoload
(defun bm-next nil
  "Goto next bookmark."
  (interactive)
  (if (= (bm-count) 0)
      (if bm-cycle-all-buffers
          (bm-first-in-next-buffer)
        (message "No bookmarks defined."))
    (let ((bm-list-forward (cdr (bm-lists 'forward))))
      ;; remove bookmark at point
      (if (bm-equal (bm-bookmark-at (point)) (car bm-list-forward))
          (setq bm-list-forward (cdr bm-list-forward)))

      (if bm-list-forward
          (bm-goto (car bm-list-forward))
        (cond (bm-cycle-all-buffers (bm-first-in-next-buffer))
              (bm-wrap-search (bm-wrap-forward))
              (t (message "No next bookmark.")))))))

(defun bm-wrap-forward nil
  "Goto next bookmark, wrapping."
  (if (or bm-wrapped bm-wrap-immediately)
      (progn
        (bm-first)
        (message "Wrapped."))
    (setq bm-wrapped t)       ; wrap on next goto
    (message "Failed: No next bookmark.")))

  
;;;###autoload
(defun bm-next-mouse (ev)
  "Go to the next bookmark with the scroll wheel.
EV is the mouse event."
  (interactive "e")
  (let ((old-selected-window (selected-window)))
    (select-window (posn-window (event-start ev)))
    (bm-next)
    (select-window old-selected-window)))


;;;###autoload
(defun bm-previous nil
  "Goto previous bookmark."
  (interactive)
  (if (= (bm-count) 0)
      (if bm-cycle-all-buffers
          (bm-last-in-previous-buffer)
        (message "No bookmarks defined."))
  (let ((bm-list-backward (car (bm-lists 'backward))))
    ;; remove bookmark at point
    (if (bm-equal (bm-bookmark-at (point)) (car bm-list-backward))
        (setq bm-list-backward (cdr bm-list-backward)))

      (if bm-list-backward
          (bm-goto (car bm-list-backward))

        (cond (bm-cycle-all-buffers (bm-last-in-previous-buffer))
              (bm-wrap-search (bm-wrap-backward))
              (t (message "No previous bookmark.")))))))

(defun bm-wrap-backward nil
  "Goto previous bookmark, wrapping."
  (if (or bm-wrapped bm-wrap-immediately)
      (progn
        (bm-last)
        (message "Wrapped."))
    (setq bm-wrapped t)       ; wrap on next goto
    (message "Failed: No previous bookmark.")))


;;;###autoload
(defun bm-previous-mouse (ev)
  "Go to the previous bookmark with the scroll wheel.
EV is the mouse event."
  (interactive "e")
  (let ((old-selected-window (selected-window)))
    (select-window (posn-window (event-start ev)))
    (bm-previous)
    (select-window old-selected-window)))


(defun bm-first-in-next-buffer nil
  "Goto first bookmark in next buffer."
  (interactive)
  (let ((buffers
         (save-excursion
           (remq nil (mapcar '(lambda (buffer)
                                (set-buffer buffer)
                                (if (> (bm-count) 0)
                                    buffer
                                  nil))
                             ;; drop current buffer from list
                             (cdr (buffer-list)))))))

    (if buffers
        (progn
          (switch-to-buffer (car buffers))
          (message "Switched to '%s'" (car buffers))
          (bm-first))
      ;; no bookmarks found in other open buffers,
      ;; wrap in current buffer?
      (if bm-wrap-search
          (bm-wrap-forward)
        (message "No bookmarks found in other open buffers.")))))



(defun bm-last-in-previous-buffer nil
  "Goto last bookmark in previous buffer."
  (interactive)
  (let ((buffers
         (save-excursion
           (remq nil (mapcar '(lambda (buffer)
                                (set-buffer buffer)
                                (if (> (bm-count) 0)
                                    buffer
                                  nil))
                             ;; drop current buffer from list
                             (reverse (cdr (buffer-list))))))))

    (if buffers
        (progn
          (switch-to-buffer (car buffers))
          (message "Switched to '%s'" (car buffers))
          (bm-last))
      ;; no bookmarks found in other open buffers,
      ;; wrap in current buffer?
      (if bm-wrap-search
          (bm-wrap-backward)
        (message "No bookmarks found in other open buffers.")))))


(defun bm-first nil
  "Goto first bookmark in buffer."
  (goto-char (point-min))
  (if (bm-bookmark-at (point))
      ;; bookmark at beginning of buffer, stop looking
      nil
    (bm-next)))


(defun bm-last nil
  "Goto first bookmark in buffer."
  (goto-char (point-max))
  (if (bm-bookmark-at (point))
      ;; bookmark at end of buffer, stop looking
      nil
    (bm-previous)))


(defun bm-remove-all-all-buffers nil
  "Delete all visible bookmarks in all open buffers."
  (interactive)
  (save-excursion
    (mapcar '(lambda (buffer)
               (set-buffer buffer)
               (bm-remove-all-current-buffer))
            (buffer-list))))


(defun bm-remove-all-current-buffer nil
  "Delete all visible bookmarks in current buffer."
  (interactive)
  (let ((bookmarks (bm-lists)))
    (mapc 'bm-bookmark-remove (append (car bookmarks) (cdr bookmarks)))))


(defun bm-toggle-wrapping nil
  "Toggle wrapping on/off, when searching for next/previous bookmark."
  (interactive)
  (setq bm-wrap-search (not bm-wrap-search))
  (if bm-wrap-search
      (message "Wrapping on.")
    (message "Wrapping off.")))


(defun bm-toggle-cycle-all-buffers nil
  "Toggle searching across all buffers."
  (interactive)
  (setq bm-cycle-all-buffers (not bm-cycle-all-buffers))
  (if bm-cycle-all-buffers
      (message "Cycle all buffers on")
    (message "Cycle all buffers off")))


(defun bm-goto (bookmark)
  "Goto specified BOOKMARK."
  (if (bm-bookmarkp bookmark)
      (progn
        (if bm-goto-position
            (goto-char (marker-position (overlay-get bookmark 'position)))
          (goto-char (overlay-start bookmark)))
        (setq bm-wrapped nil)           ; turn off wrapped state
	(if bm-recenter
	    (recenter))
        (let ((annotation (overlay-get bookmark 'annotation)))
          (if annotation
              (message annotation))))
    (message "Bookmark not found.")))


(defun bm-bookmark-regexp nil
  "Set bookmark on lines that match regexp."
  (interactive)
  (bm-bookmark-regexp-region (point-min) (point-max)))


(defun bm-bookmark-regexp-region (beg end)
  "Set bookmark on lines that match regexp in region.
Region defined by BEG and END."
  (interactive "r")
  (let ((regexp (read-from-minibuffer
		 "regexp: " nil nil nil 'bm-regexp-history))
        (annotation nil)
        (count 0))
    (save-excursion
      (if bm-annotate-on-create
          (setq annotation (read-from-minibuffer
                            "Annotation: " nil nil nil 'bm-annotation-history)))

      (goto-char beg)
      (while (re-search-forward regexp end t)
	(bm-bookmark-add annotation)
        (setq count (1+ count))
	(forward-line 1)))
    (message "%d bookmark(s) created." count)))


(defun bm-bookmark-line (line)
  "Set a bookmark on the specified LINE."
  (interactive "nSet a bookmark on line: ")
  (let ((lines (count-lines (point-min) (point-max))))
    (if (> line lines)
	(message "Unable to set bookmark at line %d. Only %d lines in buffer."
		 line lines)
      (goto-line line)
      (bm-bookmark-add))))
  

(defun bm-show-all nil
  "Show bookmarked lines in all buffers."
  (interactive)
  (let ((lines
         (save-excursion
           (mapconcat '(lambda (buffer)
                         (set-buffer buffer)
                         (bm-show-extract-bookmarks))
                      (buffer-list) ""))))
    (bm-show-display-lines lines)))


(defun bm-show nil
  "Show bookmarked lines in current buffer."
  (interactive)
  (bm-show-display-lines (bm-show-extract-bookmarks)))


(defun bm-show-extract-bookmarks nil
  "Extract bookmarks from current buffer."
  (let ((bookmarks (bm-lists)))
    (mapconcat
     '(lambda (bm)
        (let ((string
               (format "%-20s %-20s %s"
                       (format "%s:%d" (buffer-name) (count-lines (point-min) (overlay-start bm)))
                       (let ((annotation (overlay-get bm 'annotation)))
                         (if (null annotation) "" annotation))
                       (buffer-substring (overlay-start bm) (overlay-end bm)))))
          (put-text-property 0 (length string) 'bm-buffer  (buffer-name)  string)
          (put-text-property 0 (length string) 'bm-bookmark  bm  string)
          string))
     (append
      ;; xemacs has the list sorted after buffer position, while
      ;; gnu emacs list is sorted relative to current position.
      (if (featurep 'xemacs)
          (car bookmarks)
        (reverse (car bookmarks)))
      (cdr bookmarks)) "")))


(defun bm-show-display-lines (lines)
  "Show bookmarked LINES to the *bm-bookmarks* buffer."
  (if (= (length lines) 0)
      (message "No bookmarks defined.")
    (with-output-to-temp-buffer "*bm-bookmarks*"
      (set-buffer standard-output)
      (insert lines)
      (bm-show-mode)
      (setq buffer-read-only t))))


(defun bm-show-goto-bookmark nil
  "Goto the bookmark on current line in the *bm-bookmarks* buffer."
  (interactive)
  (let ((buffer-name (get-text-property (point) 'bm-buffer))
	(bookmark (get-text-property (point) 'bm-bookmark)))
    (if (null buffer-name)
	(message "No bookmark at this line.")
      (pop-to-buffer (get-buffer buffer-name))
      (bm-goto bookmark))))


(defun bm-show-bookmark nil
  "Show the bookmark on current line in the *bm-bookmarks* buffer."
  (interactive)
  (let ((buffer-name (get-text-property (point) 'bm-buffer))
	(bookmark (get-text-property (point) 'bm-bookmark)))
    (if (null buffer-name)
	(message "No bookmark at this line.")
      (let ((current-buffer (current-buffer)))
	(pop-to-buffer (get-buffer buffer-name))
	(bm-goto bookmark)
	(pop-to-buffer current-buffer)))))


(defvar bm-show-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "RET") 'bm-show-goto-bookmark)
    (define-key map (kbd "SPC") 'bm-show-bookmark)
    map)
  "Keymap for `bm-show-mode'.")


(defun bm-show-mode nil
  "Major mode for `bm-show' buffers."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'bm-show-mode)
  (setq mode-name "bm-bookmarks")
  (use-local-map bm-show-mode-map))


(defun bm-toggle-buffer-persistence nil
  "Toggle if a buffer has persistent bookmarks or not."
  (interactive)
  (if bm-buffer-persistence
      ;; turn off
      (progn
	(setq bm-buffer-persistence nil)
	(bm-repository-remove (bm-buffer-file-name)) ; remove from repository
	(message "Bookmarks in buffer are not persistent."))
    ;; turn on
    (if (not (null (bm-buffer-file-name)))
        (progn
          (setq bm-buffer-persistence (not bm-buffer-persistence))
          (bm-buffer-save)			; add to repository
          (message "Bookmarks in buffer are persistent."))
      (message "Unable to set persistent mode on a non-file buffer.")))

  ;; change color on bookmarks
  (let ((bookmarks (bm-lists)))
    (mapc '(lambda (bookmark)
	     (if bm-buffer-persistence
		 (overlay-put bookmark 'face bm-persistent-face)
	       (overlay-put bookmark 'face bm-face)))
	  (append (car bookmarks) (cdr bookmarks)))))


(defun bm-get-position-from-context (bookmark)
  "Get position of BOOKMARK based on context.
If we find the context before the old bookmark we use it,
otherwise we use the context after."
  (save-excursion
    (let ((point nil)
          (before (cdr (assoc 'before-context-string bookmark)))
          (after (cdr (assoc 'after-context-string bookmark))))

      ;; search forward for context
      (if (and after (search-forward after (point-max) t))
          (progn
            (goto-char (match-beginning 0))
            (setq point (point))))
        
      ;; search backward for context
      (if (and before (search-backward before (point-min) t))
          (progn
            (goto-char (match-end 0))
            (setq point (point))))
      point)))


(defun bm-buffer-restore nil
  "Restore bookmarks saved in the repository for the current buffer."
  (interactive)
  (let ((buffer-data (assoc (bm-buffer-file-name) bm-repository)))
    (if buffer-data
        (let ((version (cdr (assoc 'version buffer-data))))
          (cond ((= version 2)
                 (bm-buffer-restore-2 buffer-data))
                (t
                 (bm-buffer-restore-1 buffer-data))))
    (if (interactive-p) (message "No bookmarks in repository.")))))


(defun bm-buffer-restore-all nil
  "Restore bookmarks in all buffers."
  (save-current-buffer
    (mapc '(lambda (buffer)
	     (set-buffer buffer)
	     (bm-buffer-restore))
	  (buffer-list))))

(defun bm-buffer-restore-1 (buffer-data)
  "Restore bookmarks from version 1 format.
BUFFER-DATA is the content of `bm-repository-file'."
  (let ((buffer-size-match (equal (point-max) (cdr (assoc 'size buffer-data))))
        (positions (cdr (assoc 'positions buffer-data))))
      
    ;; validate buffer size
    (if (or buffer-size-match
            bm-restore-on-mismatch)
        ;; restore bookmarks
        (let ((pos nil)
              (count 0))
          
          (setq bm-buffer-persistence t) ; enable persistence
          (save-excursion
            (while positions
              (setq pos (car positions))
              
              (if (and (< pos (point-min))
                       (> (point-max) pos))
                  nil		; outside buffer, skip bookmark
                (goto-char pos)
                (bm-bookmark-add)
                (setq count (1+ count))
                (setq positions (cdr positions)))))
          
          (if buffer-size-match
              (message "%d bookmark(s) restored." count)
            (message "Buffersize mismatch. %d bookmarks restored." count)))
	
      ;; size mismatch
      (bm-repository-remove (buffer-file-name))
      (message "Buffersize mismatch. No bookmarks restored."))))


(defun bm-buffer-restore-2 (buffer-data)
  "Restore bookmarks from version 2 format.
BUFFER-DATA is the content of `bm-repository-file'."
  (let ((buffer-size-match (equal (point-max) (cdr (assoc 'size buffer-data))))
        (bookmarks (cdr (assoc 'bookmarks buffer-data))))
      
    ;; restore bookmarks
    (let ((pos nil)
          (count 0))
      
      (setq bm-buffer-persistence t) ; enable persistence
      (save-excursion
        (while bookmarks
          (let ((pos
                 (if buffer-size-match
                     (cdr (assoc 'position (car bookmarks)))
                   (bm-get-position-from-context (car bookmarks))))
                (bm nil)
                (annotation (cdr (assoc 'annotation (car bookmarks)))))
            
            (if (and (< pos (point-min))
                     (> (point-max) pos))
                nil		; outside buffer, skip bookmark
              (goto-char pos)
              (setq bm (bm-bookmark-add annotation))
              (setq count (1+ count))
              (setq bookmarks (cdr bookmarks))))))
      
      (if buffer-size-match
          (message "%d bookmark(s) restored." count)
        (message "%d bookmark(s) restored based on context." count)))))
    

(defun bm-buffer-save nil
  "Save all bookmarks to repository."
  (interactive)
  (if (not (null (bm-buffer-file-name)))
      (if bm-buffer-persistence
          (let ((buffer-data
                 (list
                  (bm-buffer-file-name)
                  (cons 'version bm-bookmark-repository-version)
                  (cons 'size (point-max))
                  (cons 'timestamp (current-time))
                  (cons 'bookmarks
                        (let ((bookmarks (bm-lists)))
                          (mapcar
                           '(lambda (bm)
                              (let ((position (marker-position (overlay-get bm 'position))))
                                (list
                                 (cons 'position position)
                                 (cons 'annotation (overlay-get bm 'annotation))
                                 (cons 'before-context-string
                                       (if (>= (point-min) (- position bm-bookmark-context-size))
                                           nil
                                         (buffer-substring-no-properties
                                          (- position bm-bookmark-context-size) position)))
                                 (cons 'after-context-string
                                       (if (>= (+ position bm-bookmark-context-size) (point-max))
                                           nil
                                         (buffer-substring-no-properties
                                          position (+ position bm-bookmark-context-size))))
                                 )))
                           (append (car bookmarks) (cdr bookmarks))))))))
            
            ;; remove if exists
            (bm-repository-remove (car buffer-data))
            
            ;; add if there exists bookmarks
            (let ((count (length (cdr (assoc 'bookmarks buffer-data)))))
              (if (> count 0)
                  (bm-repository-add buffer-data))
              (if (interactive-p)
                  (message "%d bookmark(s) saved to repository." count))))
        
        (if (interactive-p)
            (message "No bookmarks saved. Buffer is not persistent.")))

    (if (interactive-p)
        (message "Unable to save bookmarks in non-file buffers."))))


(defun bm-buffer-save-all nil
  "Save bookmarks in all buffers."
  (save-current-buffer
    (mapc '(lambda (buffer)
	     (set-buffer buffer)
	     (bm-buffer-save))
	  (buffer-list))))


(defun bm-repository-add (data)
  "Add DATA for a buffer to the repository."
  ;; appending to list, makes the list sorted by time
  (setq bm-repository (append bm-repository (list data)))
  
  ;; remove oldest element if repository is too large
  (while (and bm-repository-size
	      (> (length bm-repository) bm-repository-size))
	(setq bm-repository (cdr bm-repository))))


(defun bm-repository-remove (key)
  "Remove data for a buffer from the repository identified by KEY."
  (let ((repository nil))
    (if (not (assoc key bm-repository))
	;; don't exist in repository, do nothing
	nil
      ;; remove all occurances
      (while bm-repository
	(if (not (equal key (car (car bm-repository))))
	    (setq repository (append repository (list (car bm-repository)))))
	(setq bm-repository (cdr bm-repository)))
      (setq bm-repository repository))))


(defun bm-repository-load (&optional file)
  "Load the repository from the FILE specified or to `bm-repository-file'."
  (if (null file)
      (setq file bm-repository-file))
  (if (and file
	   (file-readable-p file))
      (let ((repository-buffer (find-file-noselect file)))
	(setq bm-repository (with-current-buffer repository-buffer
			      (goto-char (point-min))
			      (read (current-buffer))))
	(kill-buffer repository-buffer))))


(defun bm-repository-save (&optional file)
  "Save the repository to the FILE specified or to `bm-repository-file'."
  (if (null file)
      (setq file bm-repository-file))
  (if (and file
	   (file-writable-p file))
      (let ((repository-buffer (find-file-noselect file)))
	(with-current-buffer repository-buffer
	  (erase-buffer)
	  (set-buffer-file-coding-system 'utf-8)
	  (insert ";; bm.el -- persistent bookmarks. ")
	  (insert "Do not edit this file.\n")
	  (prin1 bm-repository (current-buffer))
	  (save-buffer))
	(kill-buffer repository-buffer))))


(defun bm-repository-clear nil
  "Clear the repository."
  (interactive)
  (setq bm-repository nil))


(defun bm-load-and-restore nil
  "Load bookmarks from persistent repository and restore them."
  (interactive)
  (bm-repository-load)
  (bm-buffer-restore-all))


(defun bm-save nil
  "Save bookmarks to persistent repository."
  (interactive)
  (bm-buffer-save-all)
  (bm-repository-save))
  

(defun bm-buffer-file-name nil
  "Get a unique key for the repository, even for non-file buffers."
  (cond ((equal 'Info-mode major-mode)
         (concat "[info:" Info-current-file "]"))
        ((not (null (buffer-base-buffer)))
         (concat "[indirect:" (buffer-name) ":" (buffer-file-name (buffer-base-buffer)) "]"))
        (t (buffer-file-name))))


;; restore repository on load
(if bm-restore-repository-on-load
    (bm-repository-load))


(provide 'bm)
;;; bm.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/highlight-beyond-fill-column.el0000775000000000000000000000756112230377265025245 0ustar  ;;; highlight-beyond-fill-column.el --- font-lock-add-keywords aid for Emacs

;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.

;; Author: Sandip Chitale (sandip.chitale@blazesoft.com)
;; Keywords: programming decipline convenience

;; Keywords:
;; Time-stamp: Aug 23 2001  8:56 PM Pacific Daylight Time
;; Version: 1.1

;; This file is *NOT* (yet?) part of GNU Emacs.

;; 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 2, 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; Commentary:

;; This defines a function that can be used by `font-lock-add-keywords' to find the columns
;; that are beyond `fill-column'.
;;
;; Installation:
;; Put the following in your .emacs
;;
;; (require 'highlight-beyond-fill-column)
;;
;; Example usage:
;;
;; Customize the `highlight-beyond-fill-column-in-modes' variable to
;; setup the list of modes in which to highlight-beyond-fill-column
;;
;; Customize the `highlight-beyond-fill-column-face' variable to
;; to setup the face used for highlight-beyond-fill-column
;;
;; Acknowledgement:
;;
;; This is based on initial code provided by Jim Janney (jjanney@xmission.com)
;;

;;; Code:
(defcustom highlight-beyond-fill-column-in-modes nil
  "The list of modes in which to highlight-beyond-fill-column."
  :group 'fill
  :type  '(repeat string)
  )

(defcustom highlight-beyond-fill-column-face 'underline
  "The face to use with highlight-beyond-fill-column."
  :group 'fill
  :type  'face
  )

(defun find-after-fill-column (limit)
  "A function that can be used by `font-lock-add-keywords' to find columns that are
beyond the `fill-column'."
  (let (
 ; remember the point
 (original-point (point))
 )
    ; if already past the fill column start on next line
    (if (> (current-column) fill-column)
 (forward-line 1)
      )
    (while (and (< (point) limit)                                     ; still within limit
                    (or (< (move-to-column fill-column) fill-column)  ; the line has less than `fill-column' columns
                        (= (point) (line-end-position))               ; end of line
   )
      )
      ; goto next line
      (forward-line 1)
      )

    (if (>= (point) limit)                                            ; beyond limit
 (progn
   (goto-char original-point)                                  ; restore point
   nil                                                         ; return nil
   )
      (set-match-data (list (point-marker)                            ; set match data
       (progn
         (end-of-line)
         (forward-char)                          ; this gives the highlight till the end of the window
         (point-marker)
         )
       )
        )
      t)                                                              ; return t indicating that the match data was set
    )
  )

(defun init-highlight-beyond-fill-column ()
  ""
  (let (
 (modelist highlight-beyond-fill-column-in-modes)
 mode
 )
    (while modelist
      (setq mode (intern (car modelist)))
      (if (and mode
        (functionp mode))
   (font-lock-add-keywords mode
      '(
        (find-after-fill-column 0 highlight-beyond-fill-column-face prepend)
        )
      )
 )
      (setq modelist (cdr modelist))
      )
    )
  )

(add-hook 'after-init-hook 'init-highlight-beyond-fill-column)

(provide 'highlight-beyond-fill-column)
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/dir-locals.el0000775000000000000000000001640412230377265021626 0ustar  ;;; dir-locals.el --- Local variables for a directory tree

;; Copyright (C) 2005, 2006  Free Software Foundation, Inc.

;; Author: Dave Love 
;; Keywords: files
;; $Revision: 1.1 $
;; URL: http://www.loveshack.ukfsn.org/emacs

;; This file 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 2, or (at your option)
;; any later version.

;; This file 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; It can be useful to specify local variables directory-wide, e.g. to
;; define CC mode styles consistently.  This library implements such a
;; scheme, controlled by the global minor mode `dir-locals-mode'.

;; Place a file named `.emacs-locals' (or the value of
;; `dir-locals-file-name') in the directory root.  This should specify
;; local variables in the usual way.  The values it sets are inherited
;; when a file in the directory tree is found.  Local variables
;; specified in the found file override the directory-wide ones.

;; However, `eval' pseudo-variables specified in the file are
;; evaluated (assuming `enable-local-eval' is true) _before_ any
;; directory-wide processing, and they are evaluated in a scratch
;; buffer, so that they are only useful for side effects on local
;; variables.  `mode' pseudo-variables which specify minor modes
;; toggle those modes for files within the directory.  If
;; .emacs-locals specifies a major mode, it doesn't propagate, but any
;; local variables and minor modes its hook sets will; thus it should
;; normally not specify a major mode.  The `coding' pseudo-variable
;; will not propagate from .emacs-locals.

;; For example, with dir-locals mode on, placing this in .emacs-locals
;; at the top-level of the Linux source tree would set the C
;; indentation style appropriately for files within the tree:
;;
;;   Local variables:
;;   c-file-style: "linux"
;;   End:
;;
;; (and ignore the stupid remarks in Documentation/CodingStyle).

;; Another possible use is, say, setting change-log parameters in
;; different trees for which the Emacs 22 development source broke use
;; of change-log-mode-hook.

;; NB:  This doesn't work with some versions of the Emacs 22 codebase
;; which changed the way hack-local-variables-hook is run, but the
;; change has been reverted.

;; Another, less clean, implementation of this sort of thing was
;; posted to gnu-emacs-sources as dirvals.el by Benjamin Rutt
;; , June 2006, based on work by Matt Armstrong
;; .  It uses a different format for the equivalent
;; of .emacs-locals.

;;; Code:

(defgroup dir-locals ()
  "Directory-wide file-local variables"
  :link '(emacs-commentary-link "dir-locals")
  :group 'files)

(defcustom dir-locals-file-name ".emacs-locals"
  "File name used by Dir-Locals mode to specify local variables.
This should specify local variables in the normal way.  When Dir-Locals
minor mode is active, these will be inherited by files found in a
directory tree containing such a file at its root.

This may also be a function of no arguments which returns the name to
use, allowing arbitrary per-directory customization of the
per-directory customization file on the basis of `default-directory'."
  :group 'dir-locals
  :type '(choice file function))

;; Adapted from dirvals.el.
(defcustom dir-locals-chase-remote nil
  "Non-nil means search upwards for `dir-locals-file-name' in remote filesystem."
  :group 'dir-locals
  :type 'boolean)

(define-minor-mode dir-locals-mode
  "Toggle use of directory-wide file-local variables.
See `dir-locals-file-name'."
  :global t
  (if dir-locals-mode
      (add-hook 'hack-local-variables-hook 'dir-locals-hack-local-variables)
    (remove-hook 'hack-local-variables-hook
		 'dir-locals-hack-local-variables)))

;; Following find-change-log.  Fixme:  Should be abstracted from there.
(defun dir-locals-tree-find (file)
  "Find FILE in the current directory or one of its parents.
If one is found, return its fully-qualified name, otherwise return
nil.

FILE may be a string or a nullary function returning one on the basis
of `default-directory'."
  (unless (and (not dir-locals-chase-remote)
	       (fboundp 'file-remote-p)	; not in Emacs 21
	       (file-remote-p default-directory))
    (let* ((dir-name
	    ;; Chase links in the source file and start searching in
	    ;; the dir where it resides.
	    (or (if buffer-file-name
		    (file-name-directory (file-chase-links buffer-file-name)))
		default-directory))
	   (file (if (functionp file)
		     (funcall file)
		   file))
	   (file1 (if (file-directory-p dir-name)
		      (expand-file-name file dir-name))))
      ;; Chase links before visiting the file.  This makes it easier
      ;; to use a file for several related directories.
      (setq file1 (expand-file-name (file-chase-links file1)))
      ;; Move up in the dir hierarchy till we find a suitable file.
      (while (and (not (file-exists-p file1))
		  (setq dir-name (file-name-directory
				  (directory-file-name
				   (file-name-directory file1))))
		  ;; Give up if we are already at the root dir.
		  (not (string= (file-name-directory file1) dir-name)))
	;; Move up to the parent dir and try again.
	(setq file1 (expand-file-name (file-name-nondirectory file) dir-name)))
      (if (file-exists-p file1)
	  file1))))

(defun dir-locals-hack-local-variables ()
  "Set local variables from directory-wide values.
Inherit the local variables set in `dir-locals-file-name' if that is
found by `dir-locals-tree-find'.  Ignore everything ignored by
`hack-local-variables'."
  (let* ((file (dir-locals-tree-find dir-locals-file-name))
	 (hack-local-variables-hook nil)
	 (buffer-file
	  (if buffer-file-name
	      (expand-file-name (file-chase-links buffer-file-name))))
	 ;; Fixme:  Probably condition-case this and ensure any error
	 ;; messages indicate the directory file.
	 (vars (when (and file
			  ;; Don't do it twice, so as to avoid
			  ;; repeating possible interactive queries.
			  (not (equal file buffer-file)))
		 (with-temp-buffer
		   ;; Make queries from `hack-local-variables' clearer.
		   (rename-buffer (file-name-nondirectory file) t)
		   (insert-file-contents file)
		   (let* ((locals (buffer-local-variables))
			  (_ (hack-local-variables))
			 (new-locals (buffer-local-variables)))
		     ;; Derive the list of new pairs.
		     (dolist (l locals)
		       (setq new-locals (delete l new-locals)))
		     ;; And some internals which get updated.
		     (dolist (l '(buffer-display-time buffer-display-count))
		       (setq new-locals (assq-delete-all l new-locals)))
		     new-locals)))))
    (dolist (v vars)
      (let ((sym (car v)))
	(unless (local-variable-p sym)	; file-locals take precedence
	  (if (and (string-match "-mode\\'" (symbol-name sym))
		   (fboundp sym))
	      (funcall sym)
	    (set (make-local-variable sym) (cdr v))))))))

(provide 'dir-locals)

;;; dir-locals.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/show-wspace.el0000775000000000000000000002352012230377266022033 0ustar  ;;; show-wspace.el --- Highlight whitespace of various kinds.
;;
;; Filename: show-wspace.el
;; Description: Highlight whitespace of various kinds.
;; Author: Peter Steiner , Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 2000-2009, Drew Adams, all rights reserved.
;; Created: Wed Jun 21 08:54:53 2000
;; Version: 21.0
;; Last-Updated: Sat Aug  1 15:42:17 2009 (-0700)
;;           By: dradams
;;     Update #: 282
;; URL: http://www.emacswiki.org/cgi-bin/wiki/show-wspace.el
;; Keywords: highlight, whitespace
;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
;;
;; Features that might be required by this library:
;;
;;   None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;;    Highlight whitespace of various kinds.
;;
;; To use this library:
;;
;;    Add this to your initialization file (~/.emacs or ~/_emacs):
;;
;;      (require 'show-wspace) ; Load this library.
;;
;; Then you can use commands `toggle-*' (see below) to turn the
;; various kinds of whitespace highlighting on and off in Font-Lock
;; mode.
;;
;; If you want to always use a particular kind of whitespace
;; highlighting, by default, then add the corresponding
;; `show-ws-highlight-*' function (see below) to the hook
;; `font-lock-mode-hook'.  Then, whenever Font-Lock mode is turned on,
;; whitespace highlighting will also be turned on.
;;
;; For example, you can turn on tab highlighting by default by adding
;; function `show-ws-highlight-tabs' to `font-lock-mode-hook' in your
;; .emacs file, as follows:
;;
;;     (add-hook 'font-lock-mode-hook 'show-ws-highlight-tabs)
;;
;;
;; Faces defined here:
;;
;;    `show-ws-hard-space', `show-ws-tab', `show-ws-trailing-whitespace'.
;;
;; Commands defined here:
;;
;;    `show-ws-toggle-show-hard-spaces', `show-ws-toggle-show-tabs',
;;    `show-ws-toggle-show-trailing-whitespace',
;;    `toggle-show-hard-spaces-show-ws' (alias),
;;    `toggle-show-tabs-show-ws' (alias),
;;    `toggle-show-trailing-whitespace-show-ws' (alias).
;;
;; Non-interactive functions defined here:
;;
;;    `show-ws-dont-highlight-hard-spaces',
;;    `show-ws-dont-highlight-tabs',
;;    `show-ws-dont-highlight-trailing-whitespace',
;;    `show-ws-highlight-hard-spaces', `show-ws-highlight-tabs',
;;    `show-ws-highlight-trailing-whitespace'.
;;
;; Internal variables defined here:
;;
;;    `show-ws-highlight-hard-spaces-p', `show-ws-highlight-tabs-p',
;;    `show-ws-highlight-trailing-whitespace-p'.
;;
;; Drew Adams wrote the `toggle-*' commands and `*-p' variables.
;;
;; Peter Steiner wrote the original code that did the equivalent of
;; the `show-ws-highlight-*' commands here in his `hilite-trail.el'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2009/06/25 dadams
;;     show-ws-dont-*: Should be no-op's for Emacs 20, 21.
;; 2009/06/17 dadams
;;     Added: show-ws-dont-highlight-*.
;;     show-ws-toggle-show-*: Remove the font-lock keywords. Needed for Emacs 22+.
;; 2007/09/25 dadams
;;     Renamed to use prefix show-ws-.  Thx to Cyril Brulebois.
;; 2006/11/11 dadams
;;     Corrected doc strings.  Clarified: hard space is non-breaking space, \240.
;;     Included hard space in highlight-trailing-whitespace.
;; 2006/04/06 dadams
;;     highlight-*: Use font-lock-add-keywords.  Thanks to Karl Chen.
;; 2006/02/20 dadams
;;     Mentioned in Commentary how to use non-interactively.
;; 2006/01/07 dadams
;;     Added :link for sending bug report.
;; 2006/01/06 dadams
;;     Added defgroup and use it.
;; 2005/12/30 dadams
;;     Removed require of def-face-const.el.
;;     Renamed faces, without "-face".
;; 2005/01/25 dadams
;;     Removed ###autoload for defvars.
;; 2004/06/10 dadams
;;     Fixed minor bug in highlight-* functions.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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 2, 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:

(and (< emacs-major-version 20) (eval-when-compile (require 'cl))) ;; when, push

;;;;;;;;;;;;;;;;;;;;;;;;;

(defgroup Show-Whitespace nil
  "Highlight whitespace of various kinds."
  :prefix "show-ws-"
  :group 'convenience :group 'matching
  :link `(url-link :tag "Send Bug Report"
          ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
show-wspace.el bug: \
&body=Describe bug here, starting with `emacs -q'.  \
Don't forget to mention your Emacs and library versions."))
  :link '(url-link :tag "Other Libraries by Drew"
          "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
  :link '(url-link :tag "Download"
          "http://www.emacswiki.org/cgi-bin/wiki/show-wspace.el")
  :link '(url-link :tag "Description"
          "http://www.emacswiki.org/cgi-bin/wiki/ShowWhiteSpace#ShowWspace")
  :link '(emacs-commentary-link :tag "Commentary" "show-wspace")
  )

(defface show-ws-tab '((t (:background "LemonChiffon")))
  "*Face for highlighting tab characters (`C-i') in Font-Lock mode."
  :group 'Show-Whitespace :group 'font-lock :group 'faces)

(defface show-ws-trailing-whitespace '((t (:background "Gold")))
  "*Face for highlighting whitespace at line ends in Font-Lock mode."
  :group 'Show-Whitespace :group 'font-lock :group 'faces)

(defface show-ws-hard-space '((t (:background "PaleGreen")))
  "*Face for highlighting non-breaking spaces (`\240')in Font-Lock mode."
  :group 'Show-Whitespace :group 'font-lock :group 'faces)


(defvar show-ws-highlight-tabs-p nil
  "Non-nil means font-lock mode highlights TAB characters (`C-i').")

(defvar show-ws-highlight-trailing-whitespace-p nil
  "Non-nil means font-lock mode highlights whitespace at line ends.")

(defvar show-ws-highlight-hard-spaces-p nil
  "Non-nil means font-lock mode highlights non-breaking spaces (`\240').")

;;;###autoload
(defalias 'toggle-show-tabs-show-ws 'show-ws-toggle-show-tabs)
;;;###autoload
(defun show-ws-toggle-show-tabs ()
  "Toggle highlighting of TABs, using face `show-ws-tab'."
  (interactive)
  (setq show-ws-highlight-tabs-p (not show-ws-highlight-tabs-p))
  (if show-ws-highlight-tabs-p
      (add-hook 'font-lock-mode-hook 'show-ws-highlight-tabs)
    (remove-hook 'font-lock-mode-hook 'show-ws-highlight-tabs)
    (show-ws-dont-highlight-tabs))
  (font-lock-mode) (font-lock-mode)
  (message "TAB highlighting is now %s." (if show-ws-highlight-tabs-p "ON" "OFF")))

;;;###autoload
(defalias 'toggle-show-hard-spaces-show-ws 'show-ws-toggle-show-hard-spaces)
;;;###autoload
(defun show-ws-toggle-show-hard-spaces ()
  "Toggle highlighting of non-breaking space characters (`\240').
Uses face `show-ws-hard-space'."
  (interactive)
  (setq show-ws-highlight-hard-spaces-p (not show-ws-highlight-hard-spaces-p))
  (if show-ws-highlight-hard-spaces-p
      (add-hook 'font-lock-mode-hook 'show-ws-highlight-hard-spaces)
    (remove-hook 'font-lock-mode-hook 'show-ws-highlight-hard-spaces)
    (show-ws-dont-highlight-hard-spaces))
  (font-lock-mode) (font-lock-mode)
  (message "Hard (non-breaking) space highlighting is now %s."
           (if show-ws-highlight-hard-spaces-p "ON" "OFF")))

;;;###autoload
(defalias 'toggle-show-trailing-whitespace-show-ws
    'show-ws-toggle-show-trailing-whitespace)
;;;###autoload
(defun show-ws-toggle-show-trailing-whitespace ()
  "Toggle highlighting of trailing whitespace.
Uses face `show-ws-trailing-whitespace'."
  (interactive)
  (setq show-ws-highlight-trailing-whitespace-p
        (not show-ws-highlight-trailing-whitespace-p))
  (if show-ws-highlight-trailing-whitespace-p
      (add-hook 'font-lock-mode-hook 'show-ws-highlight-trailing-whitespace)
    (remove-hook 'font-lock-mode-hook 'show-ws-highlight-trailing-whitespace)
    (show-ws-dont-highlight-trailing-whitespace))
  (font-lock-mode) (font-lock-mode)
  (message "Trailing whitespace highlighting is now %s."
           (if show-ws-highlight-trailing-whitespace-p "ON" "OFF")))

(defun show-ws-highlight-tabs ()
  "Highlight tab characters (`C-i')."
  (font-lock-add-keywords nil '(("[\t]+" (0 'show-ws-tab t)))))
(defun show-ws-highlight-hard-spaces ()
  "Highlight hard (non-breaking) space characters (`\240')."
  (font-lock-add-keywords nil '(("[\240]+" (0 'show-ws-hard-space t)))))
(defun show-ws-highlight-trailing-whitespace ()
  "Highlight whitespace characters at line ends."
  (font-lock-add-keywords
   nil '(("[\240\040\t]+$" (0 'show-ws-trailing-whitespace t)))))

;; These are no-ops for Emacs 20, 21:
;; `font-lock-remove-keywords' is not defined, and we don't need to use it.
(defun show-ws-dont-highlight-tabs ()
  "Don't highlight tab characters (`C-i')."
  (when (fboundp 'font-lock-remove-keywords)
    (font-lock-remove-keywords nil '(("[\t]+" (0 'show-ws-tab t))))))

(defun show-ws-dont-highlight-hard-spaces ()
  "Don't highlight hard (non-breaking) space characters (`\240')."
  (when (fboundp 'font-lock-remove-keywords)
    (font-lock-remove-keywords nil '(("[\240]+" (0 'show-ws-hard-space t))))))

(defun show-ws-dont-highlight-trailing-whitespace ()
  "Don't highlight whitespace characters at line ends."
  (when (fboundp 'font-lock-remove-keywords)
    (font-lock-remove-keywords
     nil '(("[\240\040\t]+$" (0 'show-ws-trailing-whitespace t))))))

;;;;;;;;;;;;;;;;;;;;;;;

(provide 'show-wspace)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; show-wspace.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/toggle-option.el0000775000000000000000000001572612230377266022373 0ustar  ;;; toggle-option.el --- easily toggle frequently toggled options

;; Copyright (C) 2001 Cyprian Laskowski

;; Author: Cyprian Laskowski 
;; Created: 8 May 2001
;; Version: 1.0
;; Keywords: convenience

;; This file is NOT currently part of GNU Emacs.

;; 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 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.


;;; Commentary:

;; I find myself toggling the same Emacs features very often, and I
;; always set up key bindings for these features.  The problem is that
;; the list is getting rather big, and it's a nuisance to sacrifice
;; individual bindings to such a simple operation as the toggling of a
;; variable.  So the idea here is: set up a customizable list of
;; options and how they are to be toggled (whether the buffer-local or
;; global value is toggled, or whether a function is called), and
;; assign ONE command (`toggle-option') to ONE key, from which all
;; those options can be easily toggled (using completion).  For
;; individual variables, you can set values to toggle to override the
;; default of nil and t.

;; Get the most recent version at http://www.swagbelly.net/elisp/lib/.

;; To install, put this file in your Emacs load-path and the following line in
;; your .emacs file:

;; (autoload 'toggle-option "toggle-option" "Easily toggle frequently toggled options." t)

;; Then load this file or restart Emacs, and customize the variable
;; `toggle-option-list': (M-x customize-variable RET toggle-option-list RET).
;; See the documentation for `toggle-option-list' for details.

;; I also highly recommend that you bind `toggle-option' to a key, by putting
;; something like the following in your .emacs file as well:

;; (global-set-key "\M-o" 'toggle-option)

;; Now you can toggle options by typing M-o (remember that completion can be
;; used on your list) and supplying the first few characters of an option.


;;; Change Log:

;; Changes from 0.1 to 1.0

;;  * toggle-option: Allow possible values of the togglable variables
;;    to range over a specified list, rather than just t and nil.
;;  * toggle-option-list: Updated customization type to reflect change
;;    in `toggle-option'.
;;  * toggle-option-default-message-function: New variable.


;;; Code:

(require 'cl)


;;; Customization variables

(defgroup toggle-option nil
  "Convenience library for toggling commonly toggled variables/functions."
  :group 'convenience)

(defcustom toggle-option-default-message-function
  'toggle-option-message-generic
  "Default function which informs you about what's been changed by `toggle-option'."
  :type '(function :value toggle-option-message-generic)
  :group 'toggle-option)

(defcustom toggle-option-list nil
  "List of options commonly toggled and interpreted by function `toggle-option'.

Each element has the form (OPTION TYPE MESSAGE-FUNC VALUES).  OPTION
is an option to toggle; it should be either a function or a variable.
Which of these it is must be specified by TYPE, which must be
'function', 'buffer-var', or 'global-var'.  If 'function', then
`toggle-option' will simply invoke that function.  If 'buffer-var',
then `toggle-option' will toggle the buffer-local value of the
variable; if 'global-var', it will toggle the global value of the
variable.  There is one exception to this: see `toggle-option' for
details.  MESSAGE-FUNC is a function to use to show the user what has
happened.  It takes two arguments, an option and a type, and it should
return a string, which will be shown in the minibuffer after
`toggle-option' is called.  It can also be nil, in which case the
function `toggle-option-default-message-function' will be used.
Finally, VALUES, if non-nil, is a list of values that the \"toggling\"
should cycle through.  If nil, the values t and nil are toggled between."
  :type '(repeat (list (symbol :tag "Function or variable")
                       (choice :value function
                               (const :tag "Function" function)
                               (const :tag "Buffer-local variable" buffer-var)
                               (const :tag "Global variable" global-var))
		       (choice :value nil
                               (function-item :tag "Default" nil)
                               (function :tag "Message function"))
                       (choice :value nil
			       (const :tag "Nil and t" nil)
			       (repeat (sexp :tag "Value")))))
  :group 'toggle-option)


;;; Commands

(defun toggle-option (option &optional arg)
  "Toggle OPTION from `toggle-option-list'.
See that variable for an explanation of how the toggling occurs and what
confirmation message is shown.  Optional prefix argument ARG specifies that the
choice of buffer vs global setting to be toggled is the opposite of that set in
`toggle-option-list'; it has no effect if the type is set to 'function'."
  (interactive
   (list (intern (completing-read
                  "Toggle option: "
                  (mapcar '(lambda (x)
                             (cons (symbol-name (car x)) nil))
                          toggle-option-list)))
         current-prefix-arg))
  (let* ((elt (assoc option toggle-option-list))
         (default-type (nth 1 elt))
         (type
          (cond ((and arg (eq default-type 'buffer-var))
                 'global-var)
                ((and arg (eq default-type 'global-var))
                 'buffer-var)
                (t default-type)))
	 (vals (nth 3 elt)))
    (if (eq type 'function)
	(funcall option)
      (let* ((global (eq type 'global-var))
	     (val-get-func (if global 'default-value 'symbol-value))
	     (val-set-func (if global 'set-default 'set))
	     (val (funcall val-get-func option))
	     (tail (member val vals)))
	(funcall val-set-func option
		 (cond
		  ((null vals) (not val))
		  ((or (null tail) (equal (car (last vals)) val)) (car vals))
		  (t (cadr tail))))))
    (message "%s"
	     (funcall
	      (or (nth 2 elt) toggle-option-default-message-function)
	      option type))))


;;; Internal functions

(defun toggle-option-message-generic (option type)
  "A generic function for possible use in `toggle-option'.
OPTION is the option being toggled, and TYPE identifies how the toggling was
done.  See `toggle-option-list' for details on what these can be."
  (cond ((eq type 'function)
         (concat "Invoked function `" (symbol-name option) "'"))
        ((eq type 'buffer-var)
         (concat "Buffer-local setting of " (symbol-name option) " toggled to: "
		 (prin1-to-string (symbol-value option))))
        ((eq type 'global-var)
         (concat "Global setting of " (symbol-name option) " toggled to: "
		 (prin1-to-string (default-value option))))))


(provide 'toggle-option)

;;; toggle-option.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/upstart-mode.el0000775000000000000000000000524012230377266022216 0ustar  ;;; upstart-mode.el --- Syntax highlighting for upstart
;;;
;;; Copyright © 2010 Stig Sandbeck Mathisen 

;;; 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 2 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, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;; 02110-1301, USA.

;;; Commentary:
;;

;;; Required: Copy this file to your load path, and add the following
;;; statement to your Emacs init file (typically ~/.emacs)
;;
;; (require 'upstart-mode)

;;; Optional: Add MMM-mode for highlighting the embedded shell scripts
;;; inside the script blocks (Note: indentation does not work inside
;;; the mmm blocks.  Any assistance would be welcome.
;;
;; (require 'mmm-auto)
;; (setq mmm-global-mode 'maybe)
;; (mmm-add-classes
;;  '((upstart-sh
;;     :submode sh-mode
;;     :face mmm-submode-decoration-level "code"
;;     :front "^\\(\\(pre\\|post\\)-\\(start\\|stop\\) \\)?script"
;;     :front-offset (end-of-line 1)
;;     :back "end script"
;;     :end-not-begin t)))
;; (mmm-add-mode-ext-class 'upstart-mode nil 'upstart-sh)


;;; History:
;;
;; This file is published on github.  To see a list of changes, see
;; http://github.com/ssm/elisp/blob/master/upstart-mode.el

;;; Code:

;; Add a major mode called "upstart mode", based on generic-mode
(define-generic-mode 'upstart-mode
  '("#")  ; comments
  '(;; Event definition
    "start on" "stop on" "and" "or"
    ;; Job environment
    "env" "export"
    ;; Services tasks and respawning
    "task" "respawn" "respawn limit" "normal exit"
    ;; Instances
    "instance"
    ;; Process environment
    "console output" "console owner" "umask" "nice" "oom" "chroot"
    "chdir" "limit"
    ;; Documentation
    "description" "author" "version" "emits"
    ;; Miscellaneous
    "kill timeout" "expect stop" "expect daemon" "expect fork"
    ;; Process definitions
    "exec" "script" "end script"
    "pre-start exec" "pre-start script"
    "post-start exec" "post-start script"
    "pre-stop exec" "pre-stop script"
    "post-stop exec" "post-stop script")
  nil
  '("\\.upstart$")
  nil
  "A mode for upstart files")

(provide 'upstart-mode)

;;; upstart-mode.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/marker-visit.el0000775000000000000000000001077312230377266022216 0ustar  ;;; marker-visit.el --- navigate through a buffer's marks in order

;; Copyright (C) 2001 Benjamin Rutt
;;
;; Maintainer: Benjamin Rutt 
;; Version: 1.1

;; This file is not part of GNU Emacs.

;; This file 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 2, 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 GNU Emacs; see the file COPYING.  If not, send e-mail to
;; this program's maintainer or write to the Free Software Foundation,
;; Inc., 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This file provides a simple way to navigate among marks in a
;; buffer.  C-u C-SPC is similar, but takes you haphazardly around the
;; buffer.  Setting bookmarks is a lot of extra work if you just want
;; to jump around your buffer quickly; plus, you have to come up with
;; a name for every bookmark.

;; All the marks you've left while editing a buffer serve as bread
;; crumb trails of areas in the buffer you've edited.  It is
;; convenient to navigate back and forth among these marks in order.
;; This file provides two methods to do just that, marker-visit-prev
;; and marker-visit-next.  These two functions will take you, from
;; point, to the nearest mark in either direction.  The function
;; marker-visit-truncate-mark-ring will truncate the mark ring.

;; The marks you can visit in a buffer consist of: "the mark" plus the
;; contents of the mark-ring.

;;; Usage:

;; put this file in your load-path and add the line
;;
;; (require 'marker-visit)
;;
;; to your ~/.emacs file.
;;
;; This package is most useful when some easy-to-press keys are bound
;; to the functions marker-visit-prev and marker-visit-next.  See C-h
;; i m Emacs RET m Key Bindings RET for info on emacs key bindings.

;;; History:

;; 1.0 -> 1.1 Incorporated patch from Colin Walters to make the code
;; consistent with elisp code conventions mentioned in 
;; (Info-goto-node "(elisp) Coding Conventions").

;;; Code:

;;utility remove-dupes function
(defun marker-visit-remove-dupes (ls)
  (cond
   ((null ls) '())
   ((member (car ls) (cdr ls)) (marker-visit-remove-dupes (cdr ls)))
   (t (cons (car ls) (marker-visit-remove-dupes (cdr ls))))))

;;create a sorted list of marks, including the point as mark, the
;;mark, and the contents of the mark-ring.
(defun marker-visit-get-sorted-mark-set (current-point-mark)
  (marker-visit-remove-dupes
   (sort
    (append (cons current-point-mark
		  (if (mark-marker) (list (mark-marker)) nil))
	    (mapcar (lambda (id) id) mark-ring))
    (lambda (a b) (< a b)))))

(defun marker-visit-no-markers-p ()
  (and (null mark-ring)
       (or (not (mark-marker))
	   (not (marker-position (mark-marker))))))

(defun marker-visit-warn (error-message)
  (message error-message)
  (beep))

(defun marker-visit-prev ()
  "From point, visit the nearest mark earlier in the buffer."
  (interactive)
  (if (marker-visit-no-markers-p)
      (marker-visit-warn "Mark does not point anywhere")
    (let* ((current-point-mark (point-marker))
	   (sorted-marks (marker-visit-get-sorted-mark-set current-point-mark))
	   (dest-mark nil))
      (while (not (equal current-point-mark (car sorted-marks)))
	(setq dest-mark (car sorted-marks))
	(setq sorted-marks (cdr sorted-marks)))
      (if dest-mark
	  (goto-char dest-mark)
	(marker-visit-warn "No previous mark to visit")))))

(defun marker-visit-next ()
  "From point, visit the nearest mark later in the buffer."
  (interactive)
  (if (marker-visit-no-markers-p)
      (marker-visit-warn "Mark does not point anywhere")
    (let* ((current-point-mark (point-marker))
	   (sorted-marks (marker-visit-get-sorted-mark-set current-point-mark))
	   (dest-mark nil)
	   (done nil))
      (while (not done)
	(if (equal current-point-mark (car sorted-marks))
	    (progn
	      (setq dest-mark (cadr sorted-marks))
	      (setq done t))
	  (setq sorted-marks (cdr sorted-marks))))
      (if dest-mark
	  (goto-char dest-mark)
	(marker-visit-warn "No next mark to visit")))))

(defun marker-visit-truncate-mark-ring ()
  "Truncate the `mark-ring'."
  (interactive)
  (setq mark-ring nil))

(provide 'marker-visit)

;; marker-visit.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/df.el0000775000000000000000000002177112230377265020171 0ustar  ;;; df.el --- display space left on partitions in the mode-line

;; Copyright (C) 1999 by Association April

;; Author: Benjamin Drieu 
;; Keywords: unix, tools

;; This file is NOT part of GNU Emacs.

;; GNU Emacs as this program are free software; you can redistribute
;; them and/or modify them under the terms of the GNU General Public
;; License as published by the Free Software Foundation; either
;; version 2, or (at your option) any later version.

;; They are both distributed in the hope that they 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:

;;  This is a quick hack to display disk usage in the mode-line.
;;  Disk space remaining is updated every `df-refresh' seconds.

;;  If you work with a lot of users sharing the same partition, it
;;  sometimes happens that there is no space left to save your work, which
;;  may drive you to serious brain damage when you lose important work.
;;  This package allows you to have the available disk space and the buffer
;;  size displayed in the mode-line, so you know when you can save your
;;  file or when it's time to do some cleanup.

;;  This package may (must) not be very optimized or efficient, but
;;  this is a quick hack.  Comments and suggestions are welcome.

;;  df is simple to use :
;;  - Put this file in your load-path
;;  and then
;;  - Put the following in your .emacs : (autoload 'df "df" nil t)
;;  - Add something like (df "/home") in your .emacs if you want to
;;    scan /home
;;  or more simply by using the custom interface:
;;    M-x customize-group df
;;  where you can toggle on `df-run-on-startup'.

;;; History:
;; 

;; $Id: df.el,v 1.6 2009-09-04 01:44:56 psg Exp $

;; $Log: df.el,v $
;; Revision 1.6  2009-09-04 01:44:56  psg
;; move df tweaks into main CVS
;;
;; Revision 1.5  2003-06-17 23:47:31  psg
;; Peter S Galbraith 
;; - Add autoload for cancel-function-timers (for XEmacs).
;;
;; Revision 1.4  2003/06/17 02:05:26  psg
;;   Peter S Galbraith 
;;   - Add customize support.  Users can now enables `df' by simply
;;     customizing variables `df-partition' and `df-run-on-startup'.
;;
;; Revision 1.3  2003/06/17 01:19:23  psg
;; Use mode-line with a hyphen, like elsewhere in Emacs.
;;
;; Revision 1.2  2003/06/17 01:02:20  psg
;; Make checkdoc clean
;;
;; Revision 1.1.1.1  2003/04/04 20:15:58  lolando
;; Initial import, based on version 19.2-1 currently in unstable.
;;
;; Revision 1.8  2001/12/07 13:08:16  benj
;; - fixed a misplaced (interactive)
;;
;; Revision 1.7  2000/06/05 11:19:22  benj
;;  - put some variables local so buffer size is buffer-local
;;  - add a hook to find-file-hook to display correct size
;;
;; Revision 1.6  1999/11/05 22:04:03  benj
;; - Now use a minor mode instead of that ugly dance with mode-line-format
;; - Really use variables instead of constants in the code
;; - Better structuration (df-enable and df-disable)
;; - Some more documentation
;; - Licence typos fixed
;;
;; Revision 1.5  1999/01/24 17:25:54  drieu
;; - Add Paal Steihaug remarks :
;;   + use magic df argument, which only scan a partition
;;   + add (require 'cl)
;;   + df-update is now much clean
;;   + df now use either 'df -m' or 'df -k' when it is needed
;;
;; Revision 1.4  1999/01/04 14:51:01  drieu
;; - Correct a bug so Megabytes are *REALLY* Megabytes
;;
;; Revision 1.3  1999/01/02 15:46:44  drieu
;; - Fix few bugs one more time
;; - Add variables instead of hard-coded strings
;; - Add argument for df
;; - Document the file a bit more
;;
;; Revision 1.2  1998/12/15 17:37:42  drieu
;; - Fix few bugs
;; - Add Buffer size in the mode line
;; - Mesure either in K or Mega bytes
;; - And so on...

;;; Code:

;; Variables that users will want to change
(defgroup df nil
  "Display space left on partitions in the mode-line."
  :group 'convenience)

(defun df-list-partitions ()
  "Return list of mounted partition directories."
  (with-temp-buffer
    (insert-file-contents "/etc/mtab")
    (let ((result))
      (while (re-search-forward "^/dev[^ ]+ \\([^ ]+\\)" nil t)
        (if result
            (add-to-list 'result (match-string 1))
          (setq result (list (match-string 1)))))
      result)))

(defcustom df-partition "/home"
  "*Partition to scan by df package."
  :group 'df
  :load 'df
  :type (append '(radio)
                (nreverse
                 (cons
                  '(string :tag "Other directory")
                  (mapcar (function (lambda (arg) `(const ,arg)))
                          (df-list-partitions))))))

(defcustom df-run-on-startup nil
  "*If non-nil, run `df' on Emacs startup."
  :group 'df
  :require 'df
  :type 'boolean
  :set (lambda (symbol value)
         (set-default symbol value)
         (if (and value df-partition)
             (df))))

;; Variables that users are unlikely to want to change
(defvar df-refresh 60
  "*Refresh rate (in seconds) of the mode-line by df.")
(defvar df-mb-threshold 10
  "*When free disk space reaches this amount (in Mb), show in Mb.")
(defvar df-megabytes-unit "M"
  "String used for displaying megabytes.")
(defvar df-kilobytes-unit "K"
  "String used for displaying kilobytes.")
(defvar df-command "df"
  "*Command used to get disk usage (usually df).")
(defvar df-in-kilobytes "-k"
  "*Argument to use when `df-command' works in kilobytes.")
(defvar df-in-megabytes "-m"
  "*Argument to use when `df-command' works in megabytes.")
(defvar df-command-arguments df-in-kilobytes
  "*Arguments for `df-command'.")

;; Seemless variables to the end user.
(defvar df-space-left ""
  "Space left on device.")
(defvar df-unit nil
  "Unit (either M or K) used for space left.")
(defvar df-mode nil)
(defvar df-string "")
(defvar df-buffer-weight "")

;; Needed because of the 'when' construct
(require 'cl)
(autoload 'cancel-function-timers "timer"
  "Cancel all timers scheduled by `run-at-time' which would run FUNCTION."
  t)

(defun df-update ()
  "Function to update disk usage.  It is used every `df-refresh' seconds."
  (interactive)
  (set-variable
   'df-buffer-weight (int-to-string (/ (length (buffer-string)) 1000)))
  (cond
   ((> (string-to-int df-space-left) (* df-mb-threshold 1000))
    (set-variable 'df-unit df-megabytes-unit)
    (setq df-command-arguments df-in-megabytes))
   ((and (< (string-to-int df-space-left) df-mb-threshold)
         (string-equal df-command-arguments df-in-megabytes))
    (set-variable 'df-unit df-kilobytes-unit)
    (setq df-command-arguments df-in-kilobytes))
   ((not df-unit)
    (set-variable 'df-unit df-kilobytes-unit)))
  (set-process-filter
   (start-process df-command nil df-command df-command-arguments df-partition)
   'df-filter))



(defun df-filter (proc string)
  "Filter for df output.
This function is responsible from updating the mode-line from the df process.
Argument PROC is the df process.
Argument STRING is the output string."
  (when (string-match (format "\\(-?[0-9]+\\) *[0-9%%]+ *%s" df-partition) string)
    (setq df-space-left (match-string 1 string))
    (if (> (string-to-int df-space-left) 1000)
	(set-variable 'df-unit df-megabytes-unit)
      (set-variable 'df-unit df-kilobytes-unit))
    (when (equal df-unit df-megabytes-unit)
      (setq df-space-left (substring df-space-left 0 (- (length df-space-left) 3)))))
  (setq df-string (format " %s%s/%s%s" df-buffer-weight df-kilobytes-unit df-space-left df-unit)))



(defun df-disable ()
  "Stop all command `df-mode' actions."
  (interactive)
  (setq df-mode nil)
  (cancel-function-timers 'df-update))



(defun df-enable ()
  "Function to display disk statistics in the mode-line."
  (interactive)
  (setq df-mode t)
  (make-variable-buffer-local 'df-buffer-weight)
  (make-variable-buffer-local 'df-string)
;;(set-default 'df-string " plop")
  (run-with-timer 0 df-refresh 'df-update)
  (if (not (assq 'df-mode minor-mode-alist))
      (setq minor-mode-alist
	    (cons '(df-mode df-string) minor-mode-alist)))
  (add-hook 'find-file-hooks 'df-update)
;;(add-hook 'write-file-hooks 'df-check)
  (df-update))



;;;(defun df-check ()
					; ca servira plus tard a
					; demander si on est sur de
					; sauvegarder le fichier quand
					; meme
;;; )


(defun df-mode (&optional arg)
  "Toggle display of space left on any filesystem in mode-lines.
This display updates automatically every `df-refresh' seconds.

With a numeric argument, enable this display if ARG is positive."
  (interactive)
  (if
      (if (null arg) (not df-mode)
	(> (prefix-numeric-value arg) 0))
      (df-enable)
    (df-disable)))



;;;###autoload
(defun df (&optional partition)
  "Enables display of space left on any PARTITION in mode-lines.
This display updates automatically every `df-refresh' seconds."
  (interactive)
  (when partition
    (set-variable 'df-partition partition))
  (df-mode 1))

(provide 'df)
;;; df.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/all.el0000775000000000000000000001560512230377265020347 0ustar  ;;; all.el --- Edit all lines matching a given regexp.

;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
;; Copyright (C) 1994 Per Abrahamsen

;; Author: Per Abrahamsen 
;; Version: $Id: all.el,v 1.2 2003-05-09 16:22:59 psg Exp $
;; Keywords: matching

;; LCD Archive Entry:
;; all|Per Abrahamsen|abraham@dina.kvl.dk|
;; Edit all lines matching a given regexp|
;; $Date: 2003-05-09 16:22:59 $|$Revision: 1.2 $|~/misc/all.Z|

;; 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 2, 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, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Comments:

;; Just like occur, except that changes in the *All* buffer is
;; propagated to the original buffer.

;; I also added highlighting of the matches.

;; You can no longer use mouse-2 to find a match in the original file,
;; since the default definition of mouse to is useful.  
;; However, `C-c C-c' still works.

;; Line numbers are not listed in the *All* buffer.

;; Ok, it is _not_ just like occur.

;; Some limitations:

;; - Undo in the *All* buffer is an ordinary change in the original.
;; - Changes to the original buffer is not reflected in the *All* buffer.
;; - A single change in the *All* buffer must be limited to a single match.

;; Requires GNU Emacs 19.23 or later.

;;; Code: 

(defvar all-mode-map ())

(if all-mode-map
    ()
  (setq all-mode-map (make-sparse-keymap))
  (define-key all-mode-map "\C-c\C-c" 'all-mode-goto))

(defvar all-buffer nil)

(defun all-mode ()
  "Major mode for output from \\[all].

All changes made in this buffer will be propagated to the buffer where
you ran \\[all].

Press \\[all-mode-goto] to go to the same spot in the original buffer."
  (kill-all-local-variables)
  (use-local-map all-mode-map)
  (setq major-mode 'all-mode)
  (setq mode-name "All")
  (make-local-variable 'all-buffer)
  (run-hooks 'all-mode-hook))

(defun all-mode-find (pos)
  ;; Find position in original buffer corresponding to POS.
  (let ((overlay (all-mode-find-overlay pos)))
    (if overlay
	(+ (marker-position (overlay-get overlay 'marker))
	   (- pos (overlay-start overlay))))))

(defun all-mode-find-overlay (pos)
  ;; Find the overlay containing POS.
  (let ((overlays (overlays-at pos)))
    (while (and overlays (null (overlay-get (car overlays) 'marker)))
      (setq overlays (cdr overlays)))
    (car-safe overlays)))

(defun all-mode-goto ()
  "Move point to the corresponding position in the original buffer."
  (interactive)
  (let ((pos (all-mode-find (point))))
    (if pos
	(pop-to-buffer all-buffer)
      (error "This text is not from the original buffer"))
    (goto-char pos)))

(defvar all-initialization-p nil)

(defun all-before-change-function (from to)
  ;; Check that change is legal
  (and all-buffer
       (not all-initialization-p)
       (let ((start (all-mode-find-overlay from))
	     (end (all-mode-find-overlay to)))
	 (not (and start (eq start end))))
       (error "Changes should be limited to a single text piece")))

(add-hook 'before-change-functions 'all-before-change-function)

(defun all-after-change-function (from to length)
  ;; Propagate changes from *All* buffer.
  (and all-buffer
       (null all-initialization-p)
       (let ((buffer (current-buffer))
	     (pos (all-mode-find from)))
	 (if pos
	     (progn
	       (set-buffer all-buffer)
	       (delete-region pos (+ pos length))
	       (save-excursion
		 (goto-char pos)
		 (insert-buffer-substring buffer from to))
	       (set-buffer buffer))))))

(add-hook 'after-change-functions 'all-after-change-function)

;;;###autoload
(defun all (regexp &optional nlines)
  "Show all lines in the current buffer containing a match for REGEXP.

If a match spreads across multiple lines, all those lines are shown.

Each line is displayed with NLINES lines before and after, or -NLINES
before if NLINES is negative.
NLINES defaults to `list-matching-lines-default-context-lines'.
Interactively it is the prefix arg.

The lines are shown in a buffer named `*All*'.
Any changes made in that buffer will be propagated to this buffer."
  (interactive (list (let* ((default (car regexp-history))
			    (input 
			     (read-from-minibuffer
			      (if default
				  (format 
   "Edit lines matching regexp (default `%s'): " default)
				"Edit lines matching regexp: ")
			      nil nil nil
			      'regexp-history)))
		       (if (> (length input) 0) input
			 (setcar regexp-history default)))
		     current-prefix-arg))
  (setq nlines (if nlines (prefix-numeric-value nlines)
		 list-matching-lines-default-context-lines))
  (setq all-initialization-p t)
  (let ((first t)
	(buffer (current-buffer))
	(prevend nil)
	(prevstart nil)
	(prevpos (point-min)))
    (with-output-to-temp-buffer "*All*"
      (save-excursion
	(set-buffer standard-output)
	(all-mode)
	(setq all-buffer buffer)
	(insert "Lines matching ")
	(prin1 regexp)
	(insert " in buffer " (buffer-name buffer) ?. ?\n)
	(insert "--------\n"))
      (if (eq buffer standard-output)
	  (goto-char (point-max)))
      (save-excursion
	(beginning-of-buffer)
	;; Find next match, but give up if prev match was at end of buffer.
	(while (and (not (= prevpos (point-max)))
		    (re-search-forward regexp nil t))
	  (goto-char (match-beginning 0))
	  (beginning-of-line)
	  (setq prevpos (point))
	  (goto-char (match-end 0))
	  (let* ((start (save-excursion
			  (goto-char (match-beginning 0))
			  (forward-line (if (< nlines 0) nlines (- nlines)))
			  (point)))
		 (end (save-excursion
			(goto-char (match-end 0))
			(if (> nlines 0)
			    (forward-line (1+ nlines))
			    (forward-line 1))
			(point)))
		 marker)
	    (cond ((null prevend)
		   (setq prevstart start
			prevend end))
		  ((> start prevend)
		   (all-insert)
		   (setq prevstart start
			 prevend end))
		  (t
		   (setq prevend end)))))
	(if prevend
	    (all-insert)))))
  (setq all-initialization-p nil))

(defun all-insert ()
  ;; Insert match.
  (save-excursion
    (setq marker (make-marker))
    (set-marker marker prevstart)
    (set-buffer standard-output)
    (let ((from (point))
	  to)
      (insert-buffer-substring buffer prevstart prevend)
      (setq to (point))
      (overlay-put (make-overlay from to) 'marker marker)
      (goto-char from)
      (while (re-search-forward regexp to t)
	(overlay-put (make-overlay (match-beginning 0) (match-end 0))
		     'face 'highlight))
      (goto-char to)
      (if (> nlines 0)
	  (insert "--------\n")))))

(provide 'all)

;;; all.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/filladapt.el0000775000000000000000000010142712230377265021535 0ustar  ;;; Adaptive fill
;;; Copyright (C) 1989, 1995-1998 Kyle E. Jones
;;;
;;; 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 2, 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.
;;;
;;; A copy of the GNU General Public License can be obtained from this
;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.
;;;
;;; Send bug reports to kyle_jones@wonderworks.com

;; LCD Archive Entry: 
;; filladapt|Kyle Jones|kyle_jones@wonderworks.com| 
;; Minor mode to adaptively set fill-prefix and overload filling functions|
;; 28-February-1998|2.12|~/packages/filladapt.el| 

;; These functions enhance the default behavior of Emacs' Auto Fill
;; mode and the commands fill-paragraph, lisp-fill-paragraph,
;; fill-region-as-paragraph and fill-region.
;;
;; The chief improvement is that the beginning of a line to be
;; filled is examined and, based on information gathered, an
;; appropriate value for fill-prefix is constructed.  Also the
;; boundaries of the current paragraph are located.  This occurs
;; only if the fill prefix is not already non-nil.
;;
;; The net result of this is that blurbs of text that are offset
;; from left margin by asterisks, dashes, and/or spaces, numbered
;; examples, included text from USENET news articles, etc. are
;; generally filled correctly with no fuss.
;;
;; Since this package replaces existing Emacs functions, it cannot
;; be autoloaded.  Save this in a file named filladapt.el in a
;; Lisp directory that Emacs knows about, byte-compile it and put
;;    (require 'filladapt)
;; in your .emacs file.
;;
;; Note that in this release Filladapt mode is a minor mode and it is
;; _off_ by default.  If you want it to be on by default, use
;;   (setq-default filladapt-mode t)
;;
;; M-x filladapt-mode toggles Filladapt mode on/off in the current
;; buffer.
;;
;; Use
;;     (add-hook 'text-mode-hook 'turn-on-filladapt-mode)
;; to have Filladapt always enabled in Text mode.
;;
;; Use
;;     (add-hook 'c-mode-hook 'turn-off-filladapt-mode)
;; to have Filladapt always disabled in C mode.
;;
;; In many cases, you can extend Filladapt by adding appropriate
;; entries to the following three `defvar's.  See `postscript-comment'
;; or `texinfo-comment' as a sample of what needs to be done.
;;
;;     filladapt-token-table
;;     filladapt-token-match-table
;;     filladapt-token-conversion-table

(and (featurep 'filladapt)
     (error "filladapt cannot be loaded twice in the same Emacs session."))

(provide 'filladapt)

(defvar filladapt-version "2.12"
  "Version string for filladapt.")

;; BLOB to make custom stuff work even without customize
(eval-and-compile
  (condition-case ()
      (require 'custom)
    (error nil))
  (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
      nil ;; We've got what we needed
    ;; We have the old custom-library, hack around it!
    (defmacro defgroup (&rest args)
      nil)
    (defmacro defcustom (var value doc &rest args) 
      (` (defvar (, var) (, value) (, doc))))))

(defgroup filladapt nil
  "Enhanced filling"
  :group 'fill)

(defvar filladapt-mode nil
  "Non-nil means that Filladapt minor mode is enabled.
Use the filladapt-mode command to toggle the mode on/off.")
(make-variable-buffer-local 'filladapt-mode)

(defcustom filladapt-mode-line-string " Filladapt"
  "*String to display in the modeline when Filladapt mode is active.
Set this to nil if you don't want a modeline indicator for Filladapt."
  :type 'string
  :group 'filladapt)

(defcustom filladapt-fill-column-tolerance nil
  "*Tolerate filled paragraph lines ending this far from the fill column.
If any lines other than the last paragraph line end at a column
less than fill-column - filladapt-fill-column-tolerance, fill-column will
be adjusted using the filladapt-fill-column-*-fuzz variables and
the paragraph will be re-filled until the tolerance is achieved
or filladapt runs out of fuzz values to try.

A nil value means behave normally, that is, don't try refilling
paragraphs to make filled line lengths fit within any particular
range."
  :type '(choice (const nil)
		 integer)
  :group 'filladapt)

(defcustom filladapt-fill-column-forward-fuzz 5
  "*Try values from fill-column to fill-column plus this variable
when trying to make filled paragraph lines fall with the tolerance
range specified by filladapt-fill-column-tolerance."
  :type 'integer
  :group 'filladapt)

(defcustom filladapt-fill-column-backward-fuzz 5
  "*Try values from fill-column to fill-column minus this variable
when trying to make filled paragraph lines fall with the tolerance
range specified by filladapt-fill-column-tolerance."
  :type 'integer
  :group 'filladapt)

;; install on minor-mode-alist
(or (assq 'filladapt-mode minor-mode-alist)
    (setq minor-mode-alist (cons (list 'filladapt-mode
				       'filladapt-mode-line-string)
				 minor-mode-alist)))

(defcustom filladapt-token-table
  '(
    ;; this must be first
    ("^" beginning-of-line)
    ;; Included text in news or mail replies
    (">+" citation->)
    ;; Included text generated by SUPERCITE.  We can't hope to match all
    ;; the possible variations, your mileage may vary.
    ("\\(\\w\\|[0-9]\\)[^'`\"< \t\n]*>[ \t]*" supercite-citation)
    ;; Lisp comments
    (";+" lisp-comment)
    ;; UNIX shell comments
    ("#+" sh-comment)
    ;; Postscript comments
    ("%+" postscript-comment)
    ;; C++ comments
    ("///*" c++-comment)
    ;; Texinfo comments
    ("@c[ \t]" texinfo-comment)
    ("@comment[ \t]" texinfo-comment)
    ;; Bullet types.
    ;;
    ;; LaTex \item
    ;;
    ("\\\\item[ \t]" bullet)
    ;;
    ;; 1. xxxxx
    ;;    xxxxx
    ;;
    ("[0-9]+\\.[ \t]" bullet)
    ;;
    ;; 2.1.3  xxxxx xx x xx x
    ;;        xxx
    ;;
    ("[0-9]+\\(\\.[0-9]+\\)+[ \t]" bullet)
    ;;
    ;; a. xxxxxx xx
    ;;    xxx xxx
    ;;
    ("[A-Za-z]\\.[ \t]" bullet)
    ;;
    ;; 1) xxxx x xx x xx   or   (1) xx xx x x xx xx
    ;;    xx xx xxxx                xxx xx x x xx x
    ;;
    ("(?[0-9]+)[ \t]" bullet)
    ;;
    ;; a) xxxx x xx x xx   or   (a) xx xx x x xx xx
    ;;    xx xx xxxx                xxx xx x x xx x
    ;;
    ("(?[A-Za-z])[ \t]" bullet)
    ;;
    ;; 2a. xx x xxx x x xxx
    ;;     xxx xx x xx x
    ;;
    ("[0-9]+[A-Za-z]\\.[ \t]" bullet)
    ;;
    ;; 1a) xxxx x xx x xx   or   (1a) xx xx x x xx xx
    ;;     xx xx xxxx                 xxx xx x x xx x
    ;;
    ("(?[0-9]+[A-Za-z])[ \t]" bullet)
    ;;
    ;; -  xx xxx xxxx   or   *  xx xx x xxx xxx
    ;;    xxx xx xx             x xxx x xx x x x
    ;;
    ("[-~*+]+[ \t]" bullet)
    ;;
    ;; o  xx xxx xxxx xx x xx xxx x xxx xx x xxx
    ;;    xxx xx xx 
    ;;
    ("o[ \t]" bullet)
    ;; don't touch
    ("[ \t]+" space)
    ("$" end-of-line)
   )
  "Table of tokens filladapt knows about.
Format is

   ((REGEXP SYM) ...)

filladapt uses this table to build a tokenized representation of
the beginning of the current line.  Each REGEXP is matched
against the beginning of the line until a match is found.
Matching is done case-sensitively.  The corresponding SYM is
added to the list, point is moved to (match-end 0) and the
process is repeated.  The process ends when there is no REGEXP in
the table that matches what is at point."
  :type '(repeat (list regexp symbol))
  :group 'filladapt)

(defcustom filladapt-not-token-table
  '(
    "[Ee]\\.g\\.[ \t,]"
    "[Ii]\\.e\\.[ \t,]"
    ;; end-of-line isn't a token if whole line is empty
    "^$"
   )
  "List of regexps that can never be a token.
Before trying the regular expressions in filladapt-token-table,
the regexps in this list are tried.  If any regexp in this list
matches what is at point then the token generator gives up and
doesn't try any of the regexps in filladapt-token-table.

Regexp matching is done case-sensitively."
  :type '(repeat regexp)
  :group 'filladapt)

(defcustom filladapt-token-match-table
  '(
    (citation-> citation->)
    (supercite-citation supercite-citation)
    (lisp-comment lisp-comment)
    (sh-comment sh-comment)
    (postscript-comment postscript-comment)
    (c++-comment c++-comment)
    (texinfo-comment texinfo-comment)
    (bullet)
    (space bullet space)
    (beginning-of-line beginning-of-line)
   )
  "Table describing what tokens a certain token will match.

To decide whether a line belongs in the current paragraph,
filladapt creates a token list for the fill prefix of both lines.
Tokens and the columns where tokens end are compared.  This table
specifies what a certain token will match.

Table format is

   (SYM [SYM1 [SYM2 ...]])

The first symbol SYM is the token, subsequent symbols are the
tokens that SYM will match."
  :type '(repeat (repeat symbol))
  :group 'filladapt)

(defcustom filladapt-token-match-many-table
  '(
    space
   )
  "List of tokens that can match multiple tokens.
If one of these tokens appears in a token list, it will eat all
matching tokens in a token list being matched against it until it
encounters a token that doesn't match or a token that ends on
a greater column number."
  :type '(repeat symbol)
  :group 'filladapt)

(defcustom filladapt-token-paragraph-start-table
  '(
    bullet
   )
  "List of tokens that indicate the start of a paragraph.
If parsing a line generates a token list containing one of
these tokens, then the line is considered to be the start of a
paragraph."
  :type '(repeat symbol)
  :group 'filladapt)

(defcustom filladapt-token-conversion-table
  '(
    (citation-> . exact)
    (supercite-citation . exact)
    (lisp-comment . exact)
    (sh-comment . exact)
    (postscript-comment . exact)
    (c++-comment . exact)
    (texinfo-comment . exact)
    (bullet . spaces)
    (space . exact)
    (end-of-line . exact)
   )
  "Table that specifies how to convert a token into a fill prefix.
Table format is

   ((SYM . HOWTO) ...)

SYM is the symbol naming the token to be converted.
HOWTO specifies how to do the conversion.
  `exact' means copy the token's string directly into the fill prefix.
  `spaces' means convert all characters in the token string that are
      not a TAB or a space into spaces and copy the resulting string into 
      the fill prefix."
  :type '(repeat (cons symbol (choice (const exact)
				      (const spaces))))
  :group 'filladapt)

(defvar filladapt-function-table
  (let ((assoc-list
	 (list (cons 'fill-paragraph (symbol-function 'fill-paragraph))
	       (cons 'fill-region (symbol-function 'fill-region))
	       (cons 'fill-region-as-paragraph
		     (symbol-function 'fill-region-as-paragraph))
	       (cons 'do-auto-fill (symbol-function 'do-auto-fill)))))
    ;; v18 Emacs doesn't have lisp-fill-paragraph
    (if (fboundp 'lisp-fill-paragraph)
	(nconc assoc-list
	       (list (cons 'lisp-fill-paragraph
			   (symbol-function 'lisp-fill-paragraph)))))
    assoc-list )
  "Table containing the old function definitions that filladapt usurps.")

(defcustom filladapt-fill-paragraph-post-hook nil
  "Hooks run after filladapt runs fill-paragraph."
  :type 'hook
  :group 'filladapt)

(defvar filladapt-inside-filladapt nil
  "Non-nil if the filladapt version of a fill function executing.
Currently this is only checked by the filladapt version of
fill-region-as-paragraph to avoid this infinite recursion:

  fill-region-as-paragraph -> fill-paragraph -> fill-region-as-paragraph ...")

(defcustom filladapt-debug nil
  "Non-nil means filladapt debugging is enabled.
Use the filladapt-debug command to turn on debugging.

With debugging enabled, filladapt will

    a. display the proposed indentation with the tokens highlighted
       using filladapt-debug-indentation-face-1 and
       filladapt-debug-indentation-face-2.
    b. display the current paragraph using the face specified by
       filladapt-debug-paragraph-face."
  :type 'boolean
  :group 'filladapt)

(if filladapt-debug
    (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe))

(defvar filladapt-debug-indentation-face-1 'highlight
  "Face used to display the indentation when debugging is enabled.")

(defvar filladapt-debug-indentation-face-2 'secondary-selection
  "Another face used to display the indentation when debugging is enabled.")

(defvar filladapt-debug-paragraph-face 'bold
  "Face used to display the current paragraph when debugging is enabled.")

(defvar filladapt-debug-indentation-extents nil)
(make-variable-buffer-local 'filladapt-debug-indentation-extents)
(defvar filladapt-debug-paragraph-extent nil)
(make-variable-buffer-local 'filladapt-debug-paragraph-extent)

;; kludge city, see references in code.
(defvar filladapt-old-line-prefix)

(defun do-auto-fill ()
  (catch 'done
    (if (and filladapt-mode (null fill-prefix))
	(save-restriction
	  (let ((paragraph-ignore-fill-prefix nil)
		;; if the user wanted this stuff, they probably
		;; wouldn't be using filladapt-mode.
		(adaptive-fill-mode nil)
		(adaptive-fill-regexp nil)
		;; need this or Emacs 19 ignores fill-prefix when
		;; inside a comment.
		(comment-multi-line t)
		(filladapt-inside-filladapt t)
		fill-prefix retval)
	    (if (filladapt-adapt nil nil)
		(progn
		  (setq retval (filladapt-funcall 'do-auto-fill))
		  (throw 'done retval))))))
    (filladapt-funcall 'do-auto-fill)))

(defun filladapt-fill-paragraph (function arg)
  (catch 'done
    (if (and filladapt-mode (null fill-prefix))
	(save-restriction
	  (let ((paragraph-ignore-fill-prefix nil)
		;; if the user wanted this stuff, they probably
		;; wouldn't be using filladapt-mode.
		(adaptive-fill-mode nil)
		(adaptive-fill-regexp nil)
		;; need this or Emacs 19 ignores fill-prefix when
		;; inside a comment.
		(comment-multi-line t)
		fill-prefix retval)
	    (if (filladapt-adapt t nil)
		(progn
		  (if filladapt-fill-column-tolerance
		      (let* ((low (- fill-column
				     filladapt-fill-column-backward-fuzz))
			     (high (+ fill-column
				      filladapt-fill-column-forward-fuzz))
			     (old-fill-column fill-column)
			     (fill-column fill-column)
			     (lim (- high low))
			     (done nil)
			     (sign 1)
			     (delta 0))
			(while (not done)
			  (setq retval (filladapt-funcall function arg))
			  (if (filladapt-paragraph-within-fill-tolerance)
			      (setq done 'success)
			    (setq delta (1+ delta)
				  sign (* sign -1)
				  fill-column (+ fill-column (* delta sign)))
			    (while (and (<= delta lim)
					(or (< fill-column low)
					    (> fill-column high)))
			      (setq delta (1+ delta)
				    sign (* sign -1)
				    fill-column (+ fill-column
						   (* delta sign))))
			    (setq done (> delta lim))))
			;; if the paragraph lines never fell
			;; within the tolerances, refill using
			;; the old fill-column.
			(if (not (eq done 'success))
			    (let ((fill-column old-fill-column))
			      (setq retval (filladapt-funcall function arg)))))
		    (setq retval (filladapt-funcall function arg)))
		  (run-hooks 'filladapt-fill-paragraph-post-hook)
		  (throw 'done retval))))))
    ;; filladapt-adapt failed, so do fill-paragraph normally.
    (filladapt-funcall function arg)))

(defun fill-paragraph (arg)
  "Fill paragraph at or after point.  Prefix arg means justify as well.

(This function has been overloaded with the `filladapt' version.)

If `sentence-end-double-space' is non-nil, then period followed by one
space does not end a sentence, so don't break a line there.

If `fill-paragraph-function' is non-nil, we call it (passing our
argument to it), and if it returns non-nil, we simply return its value."
  (interactive "*P")
  (let ((filladapt-inside-filladapt t))
    (filladapt-fill-paragraph 'fill-paragraph arg)))

(defun lisp-fill-paragraph (&optional arg)
  "Like \\[fill-paragraph], but handle Emacs Lisp comments.

(This function has been overloaded with the `filladapt' version.)

If any of the current line is a comment, fill the comment or the
paragraph of it that point is in, preserving the comment's indentation
and initial semicolons."
  (interactive "*P")
  (let ((filladapt-inside-filladapt t))
    (filladapt-fill-paragraph 'lisp-fill-paragraph arg)))

(defun fill-region-as-paragraph (beg end &optional justify
				 nosqueeze squeeze-after)
  "Fill the region as one paragraph.

(This function has been overloaded with the `filladapt' version.)

It removes any paragraph breaks in the region and extra newlines at the end,
indents and fills lines between the margins given by the
`current-left-margin' and `current-fill-column' functions.
It leaves point at the beginning of the line following the paragraph.

Normally performs justification according to the `current-justification'
function, but with a prefix arg, does full justification instead.

From a program, optional third arg JUSTIFY can specify any type of
justification.  Fourth arg NOSQUEEZE non-nil means not to make spaces
between words canonical before filling.  Fifth arg SQUEEZE-AFTER, if non-nil,
means don't canonicalize spaces before that position.

If `sentence-end-double-space' is non-nil, then period followed by one
space does not end a sentence, so don't break a line there."
  (interactive "*r\nP")
  (if (and filladapt-mode (not filladapt-inside-filladapt))
      (save-restriction
	(narrow-to-region beg end)
	(let ((filladapt-inside-filladapt t)
	      line-start last-token)
	  (goto-char beg)
	  (while (equal (char-after (point)) ?\n)
	    (delete-char 1))
	  (end-of-line)
	  (while (zerop (forward-line))
	    (if (setq last-token
		      (car (filladapt-tail (filladapt-parse-prefixes))))
		(progn
		  (setq line-start (point))
		  (move-to-column (nth 1 last-token))
		  (delete-region line-start (point))))
	    ;; Dance...
	    ;;
	    ;; Do this instead of (delete-char -1) to keep
	    ;; markers on the correct side of the whitespace.
	    (goto-char (1- (point)))
	    (insert " ")
	    (delete-char 1)

	    (end-of-line))
	  (goto-char beg)
	  (fill-paragraph justify))
	;; In XEmacs 19.12 and Emacs 18.59 fill-region relies on
	;; fill-region-as-paragraph to do this.  If we don't do
	;; it, fill-region will spin in an endless loop.
	(goto-char (point-max)))
    (condition-case nil
	;; five args for Emacs 19.31
	(filladapt-funcall 'fill-region-as-paragraph beg end
			   justify nosqueeze squeeze-after)
      (wrong-number-of-arguments
       (condition-case nil
	   ;; four args for Emacs 19.29
	   (filladapt-funcall 'fill-region-as-paragraph beg end
			      justify nosqueeze)
	 ;; three args for the rest of the world.
	 (wrong-number-of-arguments
	  (filladapt-funcall 'fill-region-as-paragraph beg end justify)))))))

(defun fill-region (beg end &optional justify nosqueeze to-eop)
  "Fill each of the paragraphs in the region.

(This function has been overloaded with the `filladapt' version.)

Prefix arg (non-nil third arg, if called from program) means justify as well.

Noninteractively, fourth arg NOSQUEEZE non-nil means to leave
whitespace other than line breaks untouched, and fifth arg TO-EOP
non-nil means to keep filling to the end of the paragraph (or next
hard newline, if `use-hard-newlines' is on).

If `sentence-end-double-space' is non-nil, then period followed by one
space does not end a sentence, so don't break a line there."
  (interactive "*r\nP")
  (if (and filladapt-mode (not filladapt-inside-filladapt))
      (save-restriction
	(narrow-to-region beg end)
	(let ((filladapt-inside-filladapt t)
	      start)
	  (goto-char beg)
	  (while (not (eobp))
	    (setq start (point))
	    (while (and (not (eobp)) (not (filladapt-parse-prefixes)))
	      (forward-line 1))
	    (if (not (equal start (point)))
		(progn
		  (save-restriction
		    (narrow-to-region start (point))
		    (fill-region start (point) justify nosqueeze to-eop)
		    (goto-char (point-max)))
		  (if (and (not (bolp)) (not (eobp)))
		      (forward-line 1))))
	    (if (filladapt-parse-prefixes)
		(progn
		  (save-restriction
		    ;; for the clipping region
		    (filladapt-adapt t t)
		    (fill-paragraph justify)
		    (goto-char (point-max)))
		  (if (and (not (bolp)) (not (eobp)))
		      (forward-line 1)))))))
    (condition-case nil
	(filladapt-funcall 'fill-region beg end justify nosqueeze to-eop)
      (wrong-number-of-arguments
       (condition-case nil
	   (filladapt-funcall 'fill-region beg end justify nosqueeze)
	 (wrong-number-of-arguments
	  (filladapt-funcall 'fill-region beg end justify)))))))

(defvar zmacs-region-stays) ; for XEmacs

(defun filladapt-mode (&optional arg)
  "Toggle Filladapt minor mode.
With arg, turn Filladapt mode on iff arg is positive.  When
Filladapt mode is enabled, auto-fill-mode and the fill-paragraph
command are both smarter about guessing a proper fill-prefix and
finding paragraph boundaries when bulleted and indented lines and
paragraphs are used."
  (interactive "P")
  ;; don't deactivate the region.
  (setq zmacs-region-stays t)
  (setq filladapt-mode (or (and arg (> (prefix-numeric-value arg) 0))
			   (and (null arg) (null filladapt-mode))))
  (if (fboundp 'force-mode-line-update)
      (force-mode-line-update)
    (set-buffer-modified-p (buffer-modified-p))))

(defun turn-on-filladapt-mode ()
  "Unconditionally turn on Filladapt mode in the current buffer."
  (filladapt-mode 1))

(defun turn-off-filladapt-mode ()
  "Unconditionally turn off Filladapt mode in the current buffer."
  (filladapt-mode -1))

(defun filladapt-funcall (function &rest args)
  "Call the old definition of a function that filladapt has usurped."
  (apply (cdr (assoc function filladapt-function-table)) args))

(defun filladapt-paragraph-start (list)
  "Returns non-nil if LIST contains a paragraph starting token.
LIST should be a token list as returned by filladapt-parse-prefixes."
  (catch 'done
    (while list
      (if (memq (car (car list)) filladapt-token-paragraph-start-table)
	  (throw 'done t))
      (setq list (cdr list)))))

(defun filladapt-parse-prefixes ()
  "Parse all the tokens after point and return a list of them.
The tokens regular expressions are specified in
filladapt-token-table.  The list returned is of this form

  ((SYM COL STRING) ...)

SYM is a token symbol as found in filladapt-token-table.
COL is the column at which the token ended.
STRING is the token's text."
  (save-excursion
    (let ((token-list nil)
	  (done nil)
	  (old-point (point))
	  (case-fold-search nil)
	  token-table not-token-table moved)
      (catch 'done
	(while (not done)
	  (setq not-token-table filladapt-not-token-table)
	  (while not-token-table
	    (if (looking-at (car not-token-table))
		(throw 'done t))
	    (setq not-token-table (cdr not-token-table)))
	  (setq token-table filladapt-token-table
		done t)
	  (while token-table
	    (if (null (looking-at (car (car token-table))))
		(setq token-table (cdr token-table))
	      (goto-char (match-end 0))
	      (setq token-list (cons (list (nth 1 (car token-table))
					   (current-column)
					   (buffer-substring
					    (match-beginning 0)
					    (match-end 0)))
				     token-list)
		    moved (not (eq (point) old-point))
		    token-table (if moved nil (cdr token-table))
		    done (not moved)
		    old-point (point))))))
      (nreverse token-list))))

(defun filladapt-tokens-match-p (list1 list2)
  "Compare two token lists and return non-nil if they match, nil otherwise.
The lists are walked through in lockstep, comparing tokens.

When two tokens A and B are compared, they are considered to
match if

    1. A appears in B's list of matching tokens or
       B appears in A's list of matching tokens
and
    2. A and B both end at the same column
         or
       A can match multiple tokens and ends at a column > than B
         or
       B can match multiple tokens and ends at a column > than A

In the case where the end columns differ the list pointer for the
token with the greater end column is not moved forward, which
allows its current token to be matched against the next token in
the other list in the next iteration of the matching loop.

All tokens must be matched in order for the lists to be considered
matching."
  (let ((matched t)
	(done nil))
    (while (and (not done) list1 list2)
      (let* ((token1 (car (car list1)))
	     (token1-matches-many-p
	         (memq token1 filladapt-token-match-many-table))
	     (token1-matches (cdr (assq token1 filladapt-token-match-table)))
	     (token1-endcol (nth 1 (car list1)))
	     (token2 (car (car list2)))
	     (token2-matches-many-p
	         (memq token2 filladapt-token-match-many-table))
	     (token2-matches (cdr (assq token2 filladapt-token-match-table)))
	     (token2-endcol (nth 1 (car list2)))
	     (tokens-match (or (memq token1 token2-matches)
			       (memq token2 token1-matches))))
	(cond ((not tokens-match)
	       (setq matched nil
		     done t))
	      ((and token1-matches-many-p token2-matches-many-p)
	       (cond ((= token1-endcol token2-endcol)
		      (setq list1 (cdr list1)
			    list2 (cdr list2)))
		     ((< token1-endcol token2-endcol)
		      (setq list1 (cdr list1)))
		     (t
		      (setq list2 (cdr list2)))))
	      (token1-matches-many-p
	       (cond ((= token1-endcol token2-endcol)
		      (setq list1 (cdr list1)
			    list2 (cdr list2)))
		     ((< token1-endcol token2-endcol)
		      (setq matched nil
			    done t))
		     (t
		      (setq list2 (cdr list2)))))
	      (token2-matches-many-p
	       (cond ((= token1-endcol token2-endcol)
		      (setq list1 (cdr list1)
			    list2 (cdr list2)))
		     ((< token2-endcol token1-endcol)
		      (setq matched nil
			    done t))
		     (t
		      (setq list1 (cdr list1)))))
	      ((= token1-endcol token2-endcol)
	       (setq list1 (cdr list1)
		     list2 (cdr list2)))
	      (t
	       (setq matched nil
		     done t)))))
    (and matched (null list1) (null list2)) ))

(defun filladapt-make-fill-prefix (list)
  "Build a fill-prefix for a token LIST.
filladapt-token-conversion-table specifies how this is done."
  (let ((prefix-list nil)
	(conversion-spec nil))
    (while list
      (setq conversion-spec (cdr (assq (car (car list))
				       filladapt-token-conversion-table)))
      (cond ((eq conversion-spec 'spaces)
	     (setq prefix-list
		   (cons
		    (filladapt-convert-to-spaces (nth 2 (car list)))
		    prefix-list)))
	    ((eq conversion-spec 'exact)
	     (setq prefix-list
		   (cons
		    (nth 2 (car list))
		    prefix-list))))
      (setq list (cdr list)))
    (apply (function concat) (nreverse prefix-list)) ))

(defun filladapt-paragraph-within-fill-tolerance ()
  (catch 'done
    (save-excursion
      (let ((low (- fill-column filladapt-fill-column-tolerance))
	    (shortline nil))
	(goto-char (point-min))
	(while (not (eobp))
	  (if shortline
	      (throw 'done nil)
	    (end-of-line)
	    (setq shortline (< (current-column) low))
	    (forward-line 1)))
	t ))))

(defun filladapt-convert-to-spaces (string)
  "Return a copy of STRING, with all non-tabs and non-space changed to spaces."
  (let ((i 0)
	(space-list '(?\  ?\t))
	(space ?\ )
	(lim (length string)))
    (setq string (copy-sequence string))
    (while (< i lim)
      (if (not (memq (aref string i) space-list))
	  (aset string i space))
      (setq i (1+ i)))
    string ))

(defun filladapt-adapt (paragraph debugging)
  "Set fill-prefix based on the contents of the current line.

If the first arg PARAGRAPH is non-nil, also set a clipping region
around the current paragraph.

If the second arg DEBUGGING is non-nil, don't do the kludge that's
necessary to make certain paragraph fills work properly."
  (save-excursion
    (beginning-of-line)
    (let ((token-list (filladapt-parse-prefixes))
	  curr-list done)
      (if (null token-list)
	  nil
	(setq fill-prefix (filladapt-make-fill-prefix token-list))
	(if paragraph
	    (let (beg end)
	      (if (filladapt-paragraph-start token-list)
		  (setq beg (point))
		(save-excursion
		  (setq done nil)
		  (while (not done)
		    (cond ((not (= 0 (forward-line -1)))
			   (setq done t
				 beg (point)))
			  ((not (filladapt-tokens-match-p
				 token-list
				 (setq curr-list (filladapt-parse-prefixes))))
			   (forward-line 1)
			   (setq done t
				 beg (point)))
			  ((filladapt-paragraph-start curr-list)
			   (setq done t
				 beg (point)))))))
	      (save-excursion
		(setq done nil)
		(while (not done)
		  (cond ((not (= 0 (progn (end-of-line) (forward-line 1))))
			 (setq done t
			       end (point)))
			((not (filladapt-tokens-match-p
			       token-list
			       (setq curr-list (filladapt-parse-prefixes))))
			 (setq done t
			       end (point)))
			((filladapt-paragraph-start curr-list)
			 (setq done t
			       end (point))))))
	      (narrow-to-region beg end)
	      ;; Multiple spaces after the bullet at the start of
	      ;; a hanging list paragraph get squashed by
	      ;; fill-paragraph.  We kludge around this by
	      ;; replacing the line prefix with the fill-prefix
	      ;; used by the rest of the lines in the paragraph.
	      ;; fill-paragraph will not alter the fill prefix so
	      ;; we win.  The post hook restores the old line prefix
	      ;; after fill-paragraph has been called.
	      (if (and paragraph (not debugging))
		  (let (col)
		    (setq col (nth 1 (car (filladapt-tail token-list))))
		    (goto-char (point-min))
		    (move-to-column col)
		    (setq filladapt-old-line-prefix
			  (buffer-substring (point-min) (point)))
		    (delete-region (point-min) (point))
		    (insert fill-prefix)
		    (add-hook 'filladapt-fill-paragraph-post-hook
			      'filladapt-cleanup-kludge-at-point-min)))))
	t ))))

(defun filladapt-cleanup-kludge-at-point-min ()
  "Cleanup the paragraph fill kludge.
See filladapt-adapt."
  (save-excursion
    (goto-char (point-min))
    (insert filladapt-old-line-prefix)
    (delete-char (length fill-prefix))
    (remove-hook 'filladapt-fill-paragraph-post-hook
		 'filladapt-cleanup-kludge-at-point-min)))

(defun filladapt-tail (list)
  "Returns the last cons in LIST."
  (if (null list)
      nil
    (while (consp (cdr list))
      (setq list (cdr list)))
    list ))

(defun filladapt-delete-extent (e)
  (if (fboundp 'delete-extent)
      (delete-extent e)
    (delete-overlay e)))

(defun filladapt-make-extent (beg end)
  (if (fboundp 'make-extent)
      (make-extent beg end)
    (make-overlay beg end)))

(defun filladapt-set-extent-endpoints (e beg end)
  (if (fboundp 'set-extent-endpoints)
      (set-extent-endpoints e beg end)
    (move-overlay e beg end)))

(defun filladapt-set-extent-property (e prop val)
  (if (fboundp 'set-extent-property)
      (set-extent-property e prop val)
    (overlay-put e prop val)))

(defun filladapt-debug ()
  "Toggle filladapt debugging on/off in the current buffer."
;;  (interactive)
  (make-local-variable 'filladapt-debug)
  (setq filladapt-debug (not filladapt-debug))
  (if (null filladapt-debug)
      (progn
	(mapcar (function (lambda (e) (filladapt-set-extent-endpoints e 1 1)))
		filladapt-debug-indentation-extents)
	(if filladapt-debug-paragraph-extent
	    (progn
	      (filladapt-delete-extent filladapt-debug-paragraph-extent)
	      (setq filladapt-debug-paragraph-extent nil)))))
  (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe))

(defun filladapt-display-debug-info-maybe ()
  (cond ((null filladapt-debug) nil)
	(fill-prefix nil)
	(t
	 (if (null filladapt-debug-paragraph-extent)
	     (let ((e (filladapt-make-extent 1 1)))
	       (filladapt-set-extent-property e 'detachable nil)
	       (filladapt-set-extent-property e 'evaporate nil)
	       (filladapt-set-extent-property e 'face
					      filladapt-debug-paragraph-face)
	       (setq filladapt-debug-paragraph-extent e)))
	 (save-excursion
	   (save-restriction
	     (let ((ei-list filladapt-debug-indentation-extents)
		   (ep filladapt-debug-paragraph-extent)
		   (face filladapt-debug-indentation-face-1)
		   fill-prefix token-list)
	       (if (null (filladapt-adapt t t))
		   (progn
		     (filladapt-set-extent-endpoints ep 1 1)
		     (while ei-list
		       (filladapt-set-extent-endpoints (car ei-list) 1 1)
		       (setq ei-list (cdr ei-list))))
		 (filladapt-set-extent-endpoints ep (point-min) (point-max))
		 (beginning-of-line)
		 (setq token-list (filladapt-parse-prefixes))
		 (message "(%s)" (mapconcat (function
					   (lambda (q) (symbol-name (car q))))
					  token-list
					  " "))
		 (while token-list
		   (if ei-list
		       (setq e (car ei-list)
			     ei-list (cdr ei-list))
		     (setq e (filladapt-make-extent 1 1))
		     (filladapt-set-extent-property e 'detachable nil)
		     (filladapt-set-extent-property e 'evaporate nil)
		     (setq filladapt-debug-indentation-extents
			   (cons e filladapt-debug-indentation-extents)))
		   (filladapt-set-extent-property e 'face face)
		   (filladapt-set-extent-endpoints e (point)
						   (progn
						     (move-to-column
						      (nth 1
							   (car token-list)))
						     (point)))
		   (if (eq face filladapt-debug-indentation-face-1)
		       (setq face filladapt-debug-indentation-face-2)
		     (setq face filladapt-debug-indentation-face-1))
		   (setq token-list (cdr token-list)))
		 (while ei-list
		   (filladapt-set-extent-endpoints (car ei-list) 1 1)
		   (setq ei-list (cdr ei-list))))))))))
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/minibuffer-complete-cycle.el0000775000000000000000000002276612230377266024637 0ustar  ;;; minibuffer-complete-cycle.el --- Cycle through the *Completions* buffer
;;; -*-unibyte: t; coding: iso-8859-1;-*-

;; Copyright � 1997,1998,2000,2003,2006 Kevin Rodgers

;; Author: Kevin Rodgers 
;; Created: 15 Oct 1997
;; Version: $Revision: 1.2 $
;; Keywords: completion
;; RCS: $Id: minibuffer-complete-cycle.el,v 1.2 2007-12-04 22:35:11 psg Exp $

;; 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 2 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, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA

;;; Commentary:

;; The `minibuffer-complete' command, bound by default to TAB in the
;; minibuffer completion keymaps, displays the list of possible
;; completions when no additional characters can be completed.
;; Subsequent invocations of this command cause the window displaying
;; the *Completions* buffer to scroll, if necessary.
;; 
;; This library advises the `minibuffer-complete' command so that
;; subsequent invocations instead select each of the possible
;; completions in turn, inserting it into the minibuffer and
;; highlighting it in the *Completions* buffer.  As before, the window
;; displaying the possible completions is scrolled if necessary.  This
;; feature is enabled by loading this file and setting the
;; `minibuffer-complete-cycle' option to t with `M-x customize-variable'
;; or `M-x set-variable'; it is disabled by unsetting the option (to
;; nil).  Besides t, the special value `auto' enables the feature and
;; also causes the first completion to be selected immediately.
;; 
;; You can also customize the `minibuffer-complete-cycle' face, which is
;; used to highlight the selected completion, with `M-x customize-face'
;; or any of the `M-x set-face-' commands.

;; The technique of deleting the minibuffer contents, then (for file
;; name completion) inserting the directory component of the initial
;; input, and then inserting the completion string itself is based on
;; cycle-mini.el (1.03) by Joe Reiss .


;;; Code:

;; Package interface:
(provide 'minibuffer-complete-cycle)

(require 'custom)			; defgroup, defcustom, defface

;; User options:

(defgroup minibuffer-complete-cycle nil
  "Cycle through the *Completions* buffer."
  :group 'completion)

(defcustom minibuffer-complete-cycle nil
  "*If non-nil, `minibuffer-complete' cycles through the possible completions.
If `auto', `minibuffer-complete' selects the first completion immediately."
  :type '(choice (const t) (const auto) (const nil))
  :group 'minibuffer-complete-cycle
  :require 'minibuffer-complete-cycle)

(defface minibuffer-complete-cycle
  '((t (:inherit secondary-selection)))
  "Face for highlighting the selected completion in the *Completions* buffer."
  :group 'minibuffer-complete-cycle)

;; Internal variables:
(defvar mcc-completion-begin nil	; point in the *Completions* buffer
  "If non-nil, the beginning of the selected completion.")
(defvar mcc-completion-end nil		; point in the *Completions* buffer
  "If non-nil, the end of the selected completion.")

(defvar mcc-completion-property
  (cond ((string-match "XEmacs" emacs-version) 'list-mode-item)
	(t 'mouse-face))
  "The text property used to identify completions.")

(defvar mcc-overlay
  (progn
    (or (face-differs-from-default-p 'minibuffer-complete-cycle)
	(copy-face 'secondary-selection 'minibuffer-complete-cycle)) ; Emacs 19
    (cond ((and (fboundp 'make-extent) (fboundp 'set-extent-property)) ; XEmacs
	   (let ((extent (make-extent 1 1)))
	     (set-extent-property extent 'face 'minibuffer-complete-cycle)
	     extent))
	  ((and (fboundp 'make-overlay) (fboundp 'overlay-put))
	   (let ((overlay (make-overlay 1 1)))
	     (overlay-put overlay 'face 'minibuffer-complete-cycle)
	     overlay))))
  "If non-nil, the overlay used to highlight the *Completions* buffer.")


;; Commands:
(defadvice minibuffer-complete (around cycle (&optional count) activate compile)
  "If the `minibuffer-complete-cycle' option is set, then instead of
just scrolling the window of possible completions, insert each one in
turn in the minibuffer and highlight it in the *Completions* buffer with
the `minibuffer-complete-cycle' face.

Prefix arg means select the COUNT'th next completion.
To cycle to previous completions, type `M-TAB'."
;; `\\\\[minibuffer-complete-backward]'
  (interactive "p")
  (if (and minibuffer-complete-cycle
	   ;; See Fminibuffer_complete:
	   (or (eq last-command this-command)
	       (and (eq minibuffer-complete-cycle 'auto)
		    (progn
		      (setq mcc-completion-begin nil
			    mcc-completion-end nil)
		      ad-do-it)))
	   minibuffer-scroll-window
	   (window-live-p minibuffer-scroll-window))
      ;; Delete the current completion, then insert and display the
      ;; next completion:
      (let ((incomplete-path
	     (if (cond ((boundp 'minibuffer-completing-file-name) ; Emacs 20
			(symbol-value 'minibuffer-completing-file-name))
		       ((eq minibuffer-completion-table
			    'read-file-name-internal)))
		 (buffer-substring (if (fboundp 'minibuffer-prompt-end)	; Emacs 21
				       (minibuffer-prompt-end)
				     (point-min))
				   (point-max)))))
	(delete-region (if (fboundp 'minibuffer-prompt-end) ; Emacs 21
			   (minibuffer-prompt-end)
			 (point-min))
		       (point-max))
	(if incomplete-path
	    (progn
	      ;; Truncate to directory:
	      (setq incomplete-path
		    (or (file-name-directory
			 (if (and mcc-completion-begin mcc-completion-end
				  (file-directory-p incomplete-path))
			     (directory-file-name incomplete-path)
			   incomplete-path))
			""))
	      (insert incomplete-path)))
	(insert (mcc-completion-string count))
	(mcc-display-completion (< count 0)))
    ;; Reset the mcc variables and proceed normally:
    (progn
      (setq mcc-completion-begin nil
	    mcc-completion-end nil)
      ad-do-it)))

(defun minibuffer-complete-backward (&optional count)
  "Just like `minibuffer-complete', but cycle to the previous completion.
Prefix arg means select the COUNT'th previous completion."
  (interactive "p")
  (setq this-command 'minibuffer-complete)
  (minibuffer-complete (- count)))


;; Functions:
(defun mcc-define-backward-key ()	; mcc-minor-mode & -keymap
  "Bind `M-TAB' to `minibuffer-complete-backward' in the local keymap.
This has no effect unless the `minibuffer-complete-cycle' option is set and
`M-TAB' is not already bound in the keymap."
  (if (and minibuffer-complete-cycle
	   (null (local-key-binding "\M-\t")))
      (local-set-key "\M-\t" 'minibuffer-complete-backward)))

(add-hook 'minibuffer-setup-hook 'mcc-define-backward-key)

(defun mcc-completion-string (n)
  "Return the Nth next completion.
If N is negative, return the Nth previous completion."
  (let ((completion-buffer (window-buffer minibuffer-scroll-window)))
    ;; Verify the buffer and window configuration:
    (or (eq completion-buffer (get-buffer "*Completions*"))
	(error "minibuffer-scroll-window isn't displaying \
the *Completions* buffer"))
    (save-excursion
      (set-buffer completion-buffer)
      ;; Find the beginning and end of the completion:
      (if (< n 0)
	  (while (< n 0)
	    (setq mcc-completion-end
		  (or (and mcc-completion-begin
			   (previous-single-property-change mcc-completion-begin
							    mcc-completion-property))
		      (point-max)))
	    (setq mcc-completion-begin
		  (previous-single-property-change mcc-completion-end
						   mcc-completion-property
						   nil (point-min)))
	    (setq n (1+ n)))
	(while (> n 0)
	  (setq mcc-completion-begin
		(next-single-property-change (if (and mcc-completion-end
						      (< mcc-completion-end
							 (point-max)))
						 mcc-completion-end
					       (point-min))
					     mcc-completion-property))
	  (setq mcc-completion-end
		(next-single-property-change mcc-completion-begin
					     mcc-completion-property
					     nil (point-max)))
	  (setq n (1- n))))
      ;; Return the next completion (buffer-substring-no-properties?):
      (buffer-substring mcc-completion-begin mcc-completion-end))))

(defun mcc-display-completion (&optional backward)
  "Highlight the current completion and scroll the *Completions* buffer \
if necessary.
Scroll up by default, but scroll down if BACKWARD is non-nil."
  (let ((completion-buffer (window-buffer minibuffer-scroll-window))
	(minibuffer-window (selected-window)))
    (if mcc-overlay
	(cond ((fboundp 'set-extent-endpoints) ; XEmacs
	       (set-extent-endpoints mcc-overlay mcc-completion-begin mcc-completion-end
				     completion-buffer))
	      ((fboundp 'move-overlay)
	       (move-overlay mcc-overlay mcc-completion-begin mcc-completion-end
			     completion-buffer))))
    (unwind-protect
	(progn
	  (select-window minibuffer-scroll-window) ; completion-buffer
	  (or (pos-visible-in-window-p mcc-completion-begin)
	      (if backward
		  (if (= (window-start) (point-min))
		      (set-window-point (selected-window) (point-max))
		    (scroll-down))
		(if (= (window-end) (point-max))
		    (set-window-point (selected-window) (point-min))
		  (scroll-up)))))
      (select-window minibuffer-window))))

;;; minibuffer-complete-cycle.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/csv-mode.el0000775000000000000000000014450612230377266021320 0ustar  ;;; csv-mode.el --- major mode for editing comma-separated value files

;; Copyright (C) 2003, 2004 Francis J. Wright

;; Author: Francis J. Wright 
;; Time-stamp: <23 August 2004>
;; URL: http://centaur.maths.qmul.ac.uk/Emacs/
;; Version: $Id: csv-mode.el,v 1.1 2005-09-28 01:52:41 psg Exp $
;; Keywords: convenience

;; This file is not part of GNU Emacs.

;; This package 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 2, or (at your option)
;; any later version.

;; This package 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This package is intended for use with GNU Emacs 21 (only) and
;; implements the following commands to process records of CSV
;; (comma-separated value) type: `csv-sort-fields' and
;; `csv-sort-numeric-fields' sort respectively lexicographically and
;; numerically on a specified field or column; `csv-reverse-region'
;; reverses the order.  They are based closely on, and use, code in
;; `sort.el'.  `csv-kill-fields' and `csv-yank-fields' respectively
;; kill and yank fields or columns, although they do not use the
;; normal kill ring.  `csv-kill-fields' can kill more than one field
;; at once, but multiple killed fields can be yanked only as a fixed
;; group equivalent to a single field.  `csv-align-fields' aligns
;; fields into columns; `csv-unalign-fields' undoes such alignment;
;; separators can be hidden within aligned records.  `csv-transpose'
;; interchanges rows and columns.  For details, see the documentation
;; for the individual commands.

;; CSV mode supports a generalised comma-separated values format
;; (character-separated values) in which the fields can be separated
;; by any of several single characters, specified by the value of the
;; customizable user option `csv-separators'.  CSV data fields can be
;; delimited by quote characters (and must if they contain separator
;; characters).  This implementation supports quoted fields, where the
;; quote characters allowed are specified by the value of the
;; customizable user option `csv-field-quotes'.  By default, the only
;; separator is a comma and the only field quote is a double quote.
;; These user options can be changed ONLY by CUSTOMIZING them,
;; e.g. via the command `customize-variable'.

;; CSV mode commands ignore blank lines and comment lines beginning
;; with the value of the buffer local variable `csv-comment-start',
;; which by default is #.  The user interface is similar to that of
;; the standard commands `sort-fields' and `sort-numeric-fields', but
;; see the major mode documentation below.

;; The global minor mode `csv-field-index-mode' provides display of
;; the current field index in the mode line, cf. `line-number-mode'
;; and `column-number-mode'.  It is on by default.

;;; Installation:

;; Put this file somewhere that Emacs can find it (i.e. in one of the
;; directories in your `load-path' such as `site-lisp'), optionally
;; byte-compile it (recommended), and put this in your .emacs file:
;;
;; (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
;; (autoload 'csv-mode "csv-mode"
;;   "Major mode for editing comma-separated value files." t)

;;; History:

;; Begun on 15 November 2003 to provide lexicographic sorting of
;; simple CSV data by field and released as csv.el.  Facilities to
;; kill multiple fields and customize separator added on 9 April 2004.
;; Converted to a major mode and renamed csv-mode.el on 10 April 2004,
;; partly at the suggestion of Stefan Monnier  to avoid conflict with csv.el by Ulf Jasper.
;; Field alignment, comment support and CSV mode customization group
;; added on 1 May 2004.  Support for index ranges added on 6 June
;; 2004.  Multiple field separators added on 12 June 2004.
;; Transposition added on 22 June 2004.  Separator invisibility added
;; on 23 June 2004.

;;; See also:

;; the standard GNU Emacs 21 packages align.el, which will align
;; columns within a region, and delim-col.el, which helps to prettify
;; columns in a text region or rectangle;

;; csv.el by Ulf Jasper , which provides
;; functions for reading/parsing comma-separated value files and is
;; available at http://de.geocities.com/ulf_jasper/emacs.html (and in
;; the gnu.emacs.sources archives).

;;; To do (maybe):

;; Make separators and quotes buffer-local and locally settable.
;; Support (La)TeX tables: set separator and comment; support record
;; end string.
;; Convert comma-separated to space- or tab-separated.

;;; Code:

(defgroup CSV nil
  "Major mode for editing files of comma-separated value type."
  :group 'convenience)

(defvar csv-separator-chars nil
  "Field separators as a list of character.
Set by customizing `csv-separators' -- do not set directly!")

(defvar csv-separator-regexp nil
  "Regexp to match a field separator.
Set by customizing `csv-separators' -- do not set directly!")

(defvar csv-skip-regexp nil
  "Regexp used by `skip-chars-forward' etc. to skip fields.
Set by customizing `csv-separators' -- do not set directly!")

(defvar csv-font-lock-keywords nil
  "Font lock keywords to highlight the field separators in CSV mode.
Set by customizing `csv-separators' -- do not set directly!")

(defcustom csv-separators '(",")
  "Field separators: a list of *single-character* strings.
For example: (\",\"), the default, or (\",\" \";\" \":\").
Neighbouring fields may be separated by any one of these characters.
The first is used when inserting a field separator into the buffer.
All must be different from the field quote characters, `csv-field-quotes'."
  ;; Suggested by Eckhard Neber 
  :group 'CSV
  :type '(repeat string)
  ;; Character would be better, but in Emacs 21.3 does not display
  ;; correctly in a customization buffer.
  :set (lambda (variable value)
	 (mapc (lambda (x)
		 (if (or (/= (length x) 1)
			 (and (boundp 'csv-field-quotes)
			      (member x csv-field-quotes)))
		     (error)))
	       value)
	 (custom-set-default variable value)
	 (setq csv-separator-chars (mapcar 'string-to-char value)
	       csv-skip-regexp (apply 'concat "^\n" csv-separators)
	       csv-separator-regexp (apply 'concat `("[" ,@value "]"))
	       csv-font-lock-keywords
	       ;; NB: csv-separator-face variable evaluates to itself.
	       `((,csv-separator-regexp . csv-separator-face)))))

(defcustom csv-field-quotes '("\"")
  "Field quotes: a list of *single-character* strings.
For example: (\"\\\"\"), the default, or (\"\\\"\" \"'\" \"`\").
A field can be delimited by a pair of any of these characters.
All must be different from the field separators, `csv-separators'."
  :group 'CSV
  :type '(repeat string)
  ;; Character would be better, but in Emacs 21 does not display
  ;; correctly in a customization buffer.
  :set (lambda (variable value)
	 (mapc (lambda (x)
		 (if (or (/= (length x) 1)
			 (member x csv-separators))
		     (error)))
	       value)
	 (when (boundp 'csv-mode-syntax-table)
	   ;; FIRST remove old quote syntax:
	   (with-syntax-table text-mode-syntax-table
	     (mapc (lambda (x)
		     (modify-syntax-entry
		      (string-to-char x)
		      (string (char-syntax (string-to-char x)))
		      ;; symbol-value to avoid compiler warning:
		      (symbol-value 'csv-mode-syntax-table)))
		   csv-field-quotes))
	   ;; THEN set new quote syntax:
	   (csv-set-quote-syntax value))
	 ;; BEFORE setting new value of `csv-field-quotes':
	 (custom-set-default variable value)))

(defun csv-set-quote-syntax (field-quotes)
  "Set syntax for field quote characters FIELD-QUOTES to be \"string\".
FIELD-QUOTES should be a list of single-character strings."
  (mapc (lambda (x)
	  (modify-syntax-entry
	   (string-to-char x) "\""
	   ;; symbol-value to avoid compiler warning:
	   (symbol-value 'csv-mode-syntax-table)))
	field-quotes))

(defvar csv-comment-start nil
  "String that starts a comment line, or nil if no comment syntax.
Such comment lines are ignored by CSV mode commands.
This variable is buffer local\; its default value is that of
`csv-comment-start-default'.  It is set by the function
`csv-set-comment-start' -- do not set it directly!")

(make-variable-buffer-local 'csv-comment-start)

(defcustom csv-comment-start-default "#"
  "String that starts a comment line, or nil if no comment syntax.
Such comment lines are ignored by CSV mode commands.
Default value of buffer-local variable `csv-comment-start'.
Changing this variable does not affect any existing CSV mode buffer."
  :group 'CSV
  :type '(choice (const :tag "None" nil) string)
  :set (lambda (variable value)
	 (custom-set-default variable value)
	 (set-default 'csv-comment-start value)))

(defcustom csv-align-style 'left
  "Aligned field style: one of 'left, 'centre, 'right or 'auto.
Alignment style used by `csv-align-fields'.
Auto-alignment means left align text and right align numbers."
  :group 'CSV
  :type '(choice (const left) (const centre)
		 (const right) (const auto)))

(defcustom csv-align-padding 1
  "Aligned field spacing: must be a positive integer.
Number of spaces used by `csv-align-fields' after separators."
  :group 'CSV
  :type 'integer)

(defcustom csv-header-lines 0
  "Header lines to skip when setting region automatically."
  :group 'CSV
  :type 'integer)

(defcustom csv-invisibility-default nil
  "If non-nil, make separators in aligned records invisible."
  :group 'CSV
  :type 'boolean)

(defface csv-separator-face
  '((((class color)) (:foreground "red"))
    (t (:weight bold)))
  "CSV mode face used to highlight separators."
  :group 'CSV)

;; This mechanism seems to keep XEmacs happy:
(defvar csv-separator-face 'csv-separator-face
  "Face name to use to highlight separators.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Mode definition, key bindings and menu
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst csv-mode-line-help-echo
  ;; See bindings.el for details of `mode-line-format' construction.
  (get-text-property 0 'help-echo (car default-mode-line-format))
  "Primary default mode line help echo text.")

(defconst csv-mode-line-format
  ;; See bindings.el for details of `mode-line-format' construction.
  (append (butlast default-mode-line-format 2)
	  (cons `(csv-field-index-string
		  ("" csv-field-index-string
		   ,(propertize "--" 'help-echo csv-mode-line-help-echo)))
		(last default-mode-line-format 2)))
  "Mode line format string for CSV mode.")

(define-derived-mode csv-mode text-mode "CSV"
  "Major mode for editing files of comma-separated value type.

CSV mode is derived from `text-mode', and runs `text-mode-hook' before
running `csv-mode-hook'.  It turns `auto-fill-mode' off by default.
CSV mode can be customized by user options in the CSV customization
group.  The separators are specified by the value of `csv-separators'.

CSV mode commands ignore blank lines and comment lines beginning with
the value of `csv-comment-start', which delimit \"paragraphs\".
\"Sexp\" is re-interpreted to mean \"field\", so that `forward-sexp'
\(\\[forward-sexp]), `kill-sexp' (\\[kill-sexp]), etc. all apply to fields.
Standard comment commands apply, such as `comment-dwim' (\\[comment-dwim]).

If `font-lock-mode' is enabled then separators, quoted values and
comment lines are highlighted using respectively `csv-separator-face',
`font-lock-string-face' and `font-lock-comment-face'.

The user interface (UI) for CSV mode commands is similar to that of
the standard commands `sort-fields' and `sort-numeric-fields', except
that if there is no prefix argument then the UI prompts for the field
index or indices.  In `transient-mark-mode' only: if the region is not
set then the UI attempts to set it to include all consecutive CSV
records around point, and prompts for confirmation; if there is no
prefix argument then the UI prompts for it, offering as a default the
index of the field containing point if the region was not set
explicitly.  The region set automatically is delimited by blank lines
and comment lines, and the number of header lines at the beginning of
the region given by the value of `csv-header-lines' are skipped.

Sort order is controlled by `csv-descending'.

CSV mode provides the following specific keyboard key bindings:

\\{csv-mode-map}"
  (turn-off-auto-fill)
  ;; Set syntax for field quotes:
  (csv-set-quote-syntax csv-field-quotes)
  ;; Make sexp functions apply to fields:
  (set (make-local-variable 'forward-sexp-function) 'csv-forward-field)
  ;; Paragraph means a group of contiguous records:
  (make-local-variable 'paragraph-separate)
  (make-local-variable 'paragraph-start)
  ;; Comment support:
  (make-local-variable 'comment-start)
  (csv-set-comment-start csv-comment-start)
  (setq
   ;; Font locking -- separator plus syntactic:
   font-lock-defaults '(csv-font-lock-keywords)
   buffer-invisibility-spec csv-invisibility-default
   ;; Mode line to support `csv-field-index-mode':
   mode-line-format csv-mode-line-format)
  ;; Enable or disable `csv-field-index-mode' (could probably do this
  ;; a bit more efficiently):
  (csv-field-index-mode (symbol-value 'csv-field-index-mode)))

(defun csv-set-comment-start (string)
  "Set comment start for this CSV mode buffer to STRING.
It must be either a string or nil."
  (interactive
   (list (edit-and-eval-command
	  "Comment start (string or nil): " csv-comment-start)))
  (setq csv-comment-start string
	paragraph-separate "[:space:]*$" ; white space
	paragraph-start "\n")		; must include \n explicitly!
  (if string
      (progn
	(setq paragraph-separate (concat paragraph-separate "\\|" string)
	      paragraph-start (concat paragraph-start "\\|" string)
	      comment-start string)
	(modify-syntax-entry
	 (string-to-char string) "<" csv-mode-syntax-table)
	(modify-syntax-entry ?\n ">" csv-mode-syntax-table))
    (with-syntax-table text-mode-syntax-table
      (modify-syntax-entry (string-to-char string)
			   (string (char-syntax (string-to-char string)))
			   csv-mode-syntax-table)
      (modify-syntax-entry ?\n
			   (string (char-syntax ?\n))
			   csv-mode-syntax-table))))

(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))

(define-key csv-mode-map [(control ?c) (control ?v)] 'csv-toggle-invisibility)
(define-key csv-mode-map [(control ?c) (control ?t)] 'csv-transpose)
(define-key csv-mode-map [(control ?c) (control ?c)] 'csv-set-comment-start)
(define-key csv-mode-map [(control ?c) (control ?u)] 'csv-unalign-fields)
(define-key csv-mode-map [(control ?c) (control ?a)] 'csv-align-fields)
(define-key csv-mode-map [(control ?c) (control ?z)] 'csv-yank-as-new-table)
(define-key csv-mode-map [(control ?c) (control ?y)] 'csv-yank-fields)
(define-key csv-mode-map [(control ?c) (control ?k)] 'csv-kill-fields)
(define-key csv-mode-map [(control ?c) (control ?d)] 'csv-toggle-descending)
(define-key csv-mode-map [(control ?c) (control ?r)] 'csv-reverse-region)
(define-key csv-mode-map [(control ?c) (control ?n)] 'csv-sort-numeric-fields)
(define-key csv-mode-map [(control ?c) (control ?s)] 'csv-sort-fields)

(defvar csv-descending nil
  "If non-nil, CSV mode sort functions sort in order of descending sort key.
Usually they sort in order of ascending sort key.")

(defun csv-toggle-descending ()
  "Toggle `csv-descending'."
  (interactive)
  (setq csv-descending (not csv-descending))
  (message "Sort order is %sscending" (if csv-descending "de" "a")))

(defun csv-toggle-invisibility ()
  "Toggle `buffer-invisibility-spec'."
  (interactive)
  (setq buffer-invisibility-spec (not buffer-invisibility-spec))
  (message "Separators in aligned records will be %svisible \
\(after re-aligning if soft\)"
	   (if buffer-invisibility-spec "in" ""))
  (redraw-frame (selected-frame)))

(easy-menu-define
  csv-menu
  csv-mode-map
  "CSV major mode menu keymap"
  '("CSV"
    ["Sort By Field Lexicographically" csv-sort-fields :active t
     :help "Sort lines in region lexicographically by the specified field"]
    ["Sort By Field Numerically" csv-sort-numeric-fields :active t
     :help "Sort lines in region numerically by the specified field"]
    ["Reverse Order of Lines" csv-reverse-region :active t
     :help "Reverse the order of the lines in the region"]
    ["Use Descending Sort Order" csv-toggle-descending :active t
     :style toggle :selected csv-descending
     :help "If selected, use descending order when sorting"]
    "--"
    ["Kill Fields (Columns)" csv-kill-fields :active t
     :help "Kill specified fields of each line in the region"]
    ["Yank Fields (Columns)" csv-yank-fields :active t
     :help "Yank killed fields as specified field of each line in region"]
    ["Yank As New Table" csv-yank-as-new-table :active t
     :help "Yank killed fields as a new table at point"]
    ["Align Fields into Columns" csv-align-fields :active t
     :help "Align the start of every field of each line in the region"]
    ["Unalign Columns into Fields" csv-unalign-fields :active t
     :help "Undo soft alignment and optionally remove redundant white space"]
    ["Transpose Rows and Columns" csv-transpose :active t
     :help "Rewrite rows (which may have different lengths) as columns"]
    "--"
    ["Forward Field" forward-sexp :active t
     :help "Move forward across one field\; with ARG, do it that many times"]
    ["Backward Field" backward-sexp :active t
     :help "Move backward across one field\; with ARG, do it that many times"]
    ["Kill Field Forward" kill-sexp :active t
     :help "Kill field following cursor\; with ARG, do it that many times"]
    ["Kill Field Backward" backward-kill-sexp :active t
     :help "Kill field preceding cursor\; with ARG, do it that many times"]
    "--"
    ("Alignment Style"
     ["Left" (setq csv-align-style 'left) :active t
      :style radio :selected (eq csv-align-style 'left)
      :help "If selected, `csv-align-fields' left aligns fields"]
     ["Centre" (setq csv-align-style 'centre) :active t
      :style radio :selected (eq csv-align-style 'centre)
      :help "If selected, `csv-align-fields' centres fields"]
     ["Right" (setq csv-align-style 'right) :active t
      :style radio :selected (eq csv-align-style 'right)
      :help "If selected, `csv-align-fields' right aligns fields"]
     ["Auto" (setq csv-align-style 'auto) :active t
      :style radio :selected (eq csv-align-style 'auto)
      :help "\
If selected, `csv-align-fields' left aligns text and right aligns numbers"]
     )
    ["Show Current Field Index" csv-field-index-mode :active t
     :style toggle :selected csv-field-index-mode
     :help "If selected, display current field index in mode line"]
    ["Make Separators Invisible" csv-toggle-invisibility :active t
     :style toggle :selected buffer-invisibility-spec
     :help "If selected, separators in aligned records are invisible"]
    ["Set Buffer's Comment Start" csv-set-comment-start :active t
     :help "Set comment start string for this buffer"]
    ["Customize CSV Mode" (customize-group 'CSV) :active t
     :help "Open a customization buffer to change CSV mode options"]
    ))

(require 'sort)

(defsubst csv-not-looking-at-record ()
  "Return t if looking at blank or comment line, nil otherwise.
Assumes point is at beginning of line."
  (looking-at paragraph-separate))

(defun csv-interactive-args (&optional type)
  "Get arg or field(s) and region interactively, offering sensible defaults.
Signal an error if the buffer is read-only.
If TYPE is noarg then return a list `(beg end)'.
Otherwise, return a list `(arg beg end)', where arg is:
  the raw prefix argument by default\;
  a single field index if TYPE is single\;
  a list of field indices or index ranges if TYPE is multiple.
Field defaults to the current prefix arg\; if not set, prompt user.

A field index list consists of positive or negative integers or ranges,
separated by any non-integer characters.  A range has the form m-n,
where m and n are positive or negative integers, m < n, and n defaults
to the last field index if omitted.

In transient mark mode, if the mark is not active then automatically
select and highlight CSV records around point, and query user.
The default field when read interactively is the current field."
  ;; Must be run interactively to activate mark!
  (let* ((arg current-prefix-arg) (default-field 1)
	 (region
	  (if (and transient-mark-mode (not mark-active))
	      ;; Set region automatically:
	      (save-excursion
		(let (startline lbp)
		  (if arg
		      (beginning-of-line)
		    (setq lbp (line-beginning-position))
		    (while (re-search-backward csv-separator-regexp lbp 1)
		      ;; Move as far as possible, i.e. to beginning of line.
		      (setq default-field (1+ default-field))))
		  (if (csv-not-looking-at-record)
		      (error "Point may not be within CSV records"))
		  (setq startline (point))
		  ;; Set mark at beginning of region:
		  (while (not (or (bobp) (csv-not-looking-at-record)))
		    (forward-line -1))
		  (if (csv-not-looking-at-record) (forward-line 1))
		  ;; Skip header lines:
		  (forward-line csv-header-lines)
		  (set-mark (point))	; OK since in save-excursion
		  ;; Move point to end of region:
		  (goto-char startline)
		  (beginning-of-line)
		  (while (not (or (eobp) (csv-not-looking-at-record)))
		    (forward-line 1))
		  ;; Show mark briefly if necessary:
		  (unless (and (pos-visible-in-window-p)
			       (pos-visible-in-window-p (mark)))
		    (exchange-point-and-mark)
		    (sit-for 1)
		    (exchange-point-and-mark))
		  (or (y-or-n-p "Region OK? ")
		      (error "Action aborted by user"))
		  (message nil)		; clear y-or-n-p message
		  (list (region-beginning) (region-end))))
	    ;; Use region set by user:
	    (list (region-beginning) (region-end)))))
    (setq default-field (number-to-string default-field))
    (cond
     ((eq type 'multiple)
      (if arg
	  ;; Ensure that field is a list:
	  (or (consp arg)
	      (setq arg (list (prefix-numeric-value arg))))
	;; Read field interactively, ignoring non-integers:
	(setq arg
	      (mapcar
	       (lambda (x)
		 (if (string-match "-" x 1) ; not first character
		     ;; Return a range as a pair - the cdr may be nil:
		     (let ((m (substring x 0 (match-beginning 0)))
			   (n (substring x (match-end 0))))
		       (cons (car (read-from-string m))
			     (and (not (string= n ""))
				  (car (read-from-string n)))))
		   ;; Return a number as a number:
		   (car (read-from-string x))))
	       (split-string
		(read-string
		 "Fields (sequence of integers or ranges): " default-field)
		"[^-+0-9]+")))))
     ((eq type 'single)
      (if arg
	  (setq arg (prefix-numeric-value arg))
	(while (not (integerp arg))
	  (setq arg (eval-minibuffer "Field (integer): " default-field))))))
    (if (eq type 'noarg) region (cons arg region))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Sorting by field
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun csv-nextrecfun ()
  "Called by `csv-sort-fields-1' with point at end of previous record.
It moves point to the start of the next record.
It should move point to the end of the buffer if there are no more records."
  (forward-line)
  (while (and (not (eobp)) (csv-not-looking-at-record))
    (forward-line)))

(defun csv-sort-fields-1 (field beg end startkeyfun endkeyfun)
  "Modified version of `sort-fields-1' that skips blank or comment lines.

FIELD is a single field index, and BEG and END specify the region to
sort.

STARTKEYFUN moves from the start of the record to the start of the key.
It may return either a non-nil value to be used as the key, or
else the key is the substring between the values of point after
STARTKEYFUN and ENDKEYFUN are called.  If STARTKEYFUN is nil, the key
starts at the beginning of the record.

ENDKEYFUN moves from the start of the sort key to the end of the sort key.
ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the
same as ENDRECFUN."
  (let ((tbl (syntax-table)))
    (if (zerop field) (setq field 1))
    (unwind-protect
	(save-excursion
	  (save-restriction
	    (narrow-to-region beg end)
	    (goto-char (point-min))
	    (set-syntax-table sort-fields-syntax-table)
	    (sort-subr csv-descending
		       'csv-nextrecfun 'end-of-line
		       startkeyfun endkeyfun)))
      (set-syntax-table tbl))))

(defun csv-sort-fields (field beg end)
  "Sort lines in region lexicographically by the ARGth field of each line.
If not set, the region defaults to the CSV records around point.
Fields are separated by `csv-separators' and null fields are allowed anywhere.
Field indices increase from 1 on the left or decrease from -1 on the right.
A prefix argument specifies a single field, otherwise prompt for field index.
Ignore blank and comment lines.  The variable `sort-fold-case'
determines whether alphabetic case affects the sort order.
When called non-interactively, FIELD is a single field index\;
BEG and END specify the region to sort."
  ;; (interactive "*P\nr")
  (interactive (csv-interactive-args 'single))
  (barf-if-buffer-read-only)
  (csv-sort-fields-1 field beg end
		     (lambda () (csv-sort-skip-fields field) nil)
		     (lambda () (skip-chars-forward csv-skip-regexp))))

(defun csv-sort-numeric-fields (field beg end)
  "Sort lines in region numerically by the ARGth field of each line.
If not set, the region defaults to the CSV records around point.
Fields are separated by `csv-separators'.
Null fields are allowed anywhere and sort as zeros.
Field indices increase from 1 on the left or decrease from -1 on the right.
A prefix argument specifies a single field, otherwise prompt for field index.
Specified non-null field must contain a number in each line of the region,
which may begin with \"0x\" or \"0\" for hexadecimal and octal values.
Otherwise, the number is interpreted according to sort-numeric-base.
Ignore blank and comment lines.
When called non-interactively, FIELD is a single field index\;
BEG and END specify the region to sort."
  ;; (interactive "*P\nr")
  (interactive (csv-interactive-args 'single))
  (barf-if-buffer-read-only)
  (csv-sort-fields-1 field beg end
		 (lambda ()
		   (csv-sort-skip-fields field)
		   (let* ((case-fold-search t)
			  (base
			   (if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]")
			       (cond ((match-beginning 1)
				      (goto-char (match-end 1))
				      16)
				     ((match-beginning 2)
				      (goto-char (match-end 2))
				      8)
				     (t nil)))))
		     (string-to-number (buffer-substring (point)
							 (save-excursion
							   (forward-sexp 1)
							   (point)))
				       (or base sort-numeric-base))))
		 nil))

(defun csv-reverse-region (beg end)
  "Reverse the order of the lines in the region.
This is just a CSV-mode style interface to `reverse-region', which is
the function that should be used non-interactively.  It takes two
point or marker arguments, BEG and END, delimiting the region."
  ;; (interactive "*P\nr")
  (interactive (csv-interactive-args 'noarg))
  (barf-if-buffer-read-only)
  (reverse-region beg end))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Moving by field
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defsubst csv-end-of-field ()
  "Skip forward over one field."
  (skip-syntax-forward " ")
  (if (eq (char-syntax (following-char)) ?\")
      (goto-char (scan-sexps (point) 1)))
  (skip-chars-forward csv-skip-regexp))

(defsubst csv-beginning-of-field ()
  "Skip backward over one field."
  (skip-syntax-backward " ")
  (if (eq (char-syntax (preceding-char)) ?\")
      (goto-char (scan-sexps (point) -1)))
  (skip-chars-backward csv-skip-regexp))

(defun csv-forward-field (arg)
  "Move forward across one field, cf. `forward-sexp'.
With ARG, do it that many times.  Negative arg -N means
move backward across N fields."
  (interactive "p")
  (if (< arg 0)
      (csv-backward-field (- arg))
    (while (>= (setq arg (1- arg)) 0)
      (if (or (bolp)
	      (when (and (not (eobp)) (eolp)) (forward-char) t))
	  (while (and (not (eobp)) (csv-not-looking-at-record))
	    (forward-line 1)))
      (if (memq (following-char) csv-separator-chars) (forward-char))
      (csv-end-of-field))))

(defun csv-backward-field (arg)
  "Move backward across one field, cf. `backward-sexp'.
With ARG, do it that many times.  Negative arg -N means
move forward across N fields."
  (interactive "p")
  (if (< arg 0)
      (csv-forward-field (- arg))
    (while (>= (setq arg (1- arg)) 0)
      (when (or (eolp)
		(when (and (not (bobp)) (bolp)) (backward-char) t))
	(while (progn
		 (beginning-of-line)
		 (csv-not-looking-at-record))
	  (backward-char))
	(end-of-line))
      (if (memq (preceding-char) csv-separator-chars) (backward-char))
      (csv-beginning-of-field))))

(defun csv-sort-skip-fields (n &optional yank)
  "Position point at the beginning of field N on the current line.
Fields are separated by `csv-separators'\; null terminal field allowed.
Assumes point is initially at the beginning of the line.
YANK non-nil allows N to be greater than the number of fields, in
which case extend the record as necessary."
  (if (> n 0)
      ;; Skip across N - 1 fields.
      (let ((i (1- n)))
	(while (> i 0)
	  (csv-end-of-field)
	  (if (eolp)
	      (if yank
		  (if (> i 1) (insert (car csv-separators)))
		(error "Line has too few fields: %s"
		       (buffer-substring
			(save-excursion (beginning-of-line) (point))
			(save-excursion (end-of-line) (point)))))
	    (forward-char))		; skip separator
	  (setq i (1- i))))
    (end-of-line)
    ;; Skip back across -N - 1 fields.
    (let ((i (1- (- n))))
      (while (> i 0)
	(csv-beginning-of-field)
	(if (bolp)
	    (error "Line has too few fields: %s"
		   (buffer-substring
		    (save-excursion (beginning-of-line) (point))
		    (save-excursion (end-of-line) (point)))))
	(backward-char)			; skip separator
	(setq i (1- i)))
      ;; Position at the front of the field
      ;; even if moving backwards.
      (csv-beginning-of-field))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Field index mode
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Based partly on paren.el

(defcustom csv-field-index-delay 0.125
  "Time in seconds to delay before updating field index display."
  :group 'CSV
  :type '(number :tag "seconds"))

(defvar csv-field-index-idle-timer nil)

(defvar csv-field-index-string nil)
(make-variable-buffer-local 'csv-field-index-string)

(defvar csv-field-index-old nil)
(make-variable-buffer-local 'csv-field-index-old)

(define-minor-mode csv-field-index-mode
  "Toggle CSV-Field-Index mode.
With prefix ARG, turn CSV-Field-Index mode on if and only if ARG is positive.
Returns the new status of CSV-Field-Index mode (non-nil means on).
When CSV-Field-Index mode is enabled, the current field index appears in
the mode line after `csv-field-index-delay' seconds of Emacs idle time."
  :group 'CSV
  :global t
  :init-value t		       ; for documentation, since default is t
  ;; This macro generates a function that first sets the mode
  ;; variable, then runs the following code, runs the mode hooks,
  ;; displays a message if interactive, updates the mode line and
  ;; finally returns the variable value.

  ;; First, always disable the mechanism (to avoid having two timers):
  (when csv-field-index-idle-timer
    (cancel-timer csv-field-index-idle-timer)
    (setq csv-field-index-idle-timer nil))
  ;; Now, if the mode is on and any buffer is in CSV mode then
  ;; re-initialize and enable the mechanism by setting up a new timer:
  (if csv-field-index-mode
      (if (memq t (mapcar (lambda (buffer)
			    (with-current-buffer buffer
			      (when (eq major-mode 'csv-mode)
				(setq csv-field-index-string nil
				      csv-field-index-old nil)
				t)))
			  (buffer-list)))
	  (setq csv-field-index-idle-timer
		(run-with-idle-timer csv-field-index-delay t
				     'csv-field-index)))
    ;; but if the mode is off then remove the display from the mode
    ;; lines of all CSV buffers:
    (mapc (lambda (buffer)
	    (with-current-buffer buffer
	      (when (eq major-mode 'csv-mode)
		(setq csv-field-index-string nil
		      csv-field-index-old nil)
		(force-mode-line-update))))
	    (buffer-list))))

(defun csv-field-index ()
  "Construct `csv-field-index-string' to display in mode line.
Called by `csv-field-index-idle-timer'."
  (if (eq major-mode 'csv-mode)
      (save-excursion
	(let ((lbp (line-beginning-position)) (field 1))
	  (while (re-search-backward csv-separator-regexp lbp 1)
	    ;; Move as far as possible, i.e. to beginning of line.
	    (setq field (1+ field)))
	  (if (csv-not-looking-at-record) (setq field nil))
	  (when (not (eq field csv-field-index-old))
	    (setq csv-field-index-old field
		  csv-field-index-string
		  (and field (propertize (format "F%d" field)
					 'help-echo csv-mode-line-help-echo)))
	    (force-mode-line-update))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Killing and yanking fields
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar csv-killed-fields nil
  "A list of the fields or sub-records last killed by `csv-kill-fields'.")

(defun csv-kill-fields (fields beg end)
  "Kill specified fields of each line in the region.
If not set, the region defaults to the CSV records around point.
Fields are separated by `csv-separators' and null fields are allowed anywhere.
Field indices increase from 1 on the left or decrease from -1 on the right.
The fields are stored for use by `csv-yank-fields'.  Fields can be
specified in any order but are saved in increasing index order.
Ignore blank and comment lines.

When called interactively, a prefix argument specifies a single field,
otherwise prompt for a field list, which may include ranges in the form
m-n, where m < n and n defaults to the last field index if omitted.

When called non-interactively, FIELDS is a single field index or a
list of field indices, with ranges specified as (m.n) or (m), and BEG
and END specify the region to process."
  ;; (interactive "*P\nr")
  (interactive (csv-interactive-args 'multiple))
  (barf-if-buffer-read-only)
  ;; Kill the field(s):
  (setq csv-killed-fields nil)
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (if (or (cdr fields) (consp (car fields)))
	  (csv-kill-many-columns fields)
	(csv-kill-one-column (car fields)))))
  (setq csv-killed-fields (nreverse csv-killed-fields)))

(defmacro csv-kill-one-field (field killed-fields)
  "Kill field with index FIELD in current line.
Save killed field by `push'ing onto KILLED-FIELDS.
Assumes point is at beginning of line.
Called by `csv-kill-one-column' and `csv-kill-many-columns'."
  `(progn
     ;; Move to start of field to kill:
     (csv-sort-skip-fields ,field)
     ;; Kill to end of field (cf. `kill-region'):
     (push (delete-and-extract-region
	    (point)
	    (progn (csv-end-of-field) (point)))
	   ,killed-fields)
     (if (eolp) (delete-char -1)    ; delete trailing separator at eol
       (delete-char 1))))	    ; or following separator otherwise

(defun csv-kill-one-column (field)
  "Kill field with index FIELD in all lines in (narrowed) buffer.
Save killed fields in `csv-killed-fields'.
Assumes point is at `point-min'.  Called by `csv-kill-fields'.
Ignore blank and comment lines."
  (while (not (eobp))
    (or (csv-not-looking-at-record)
	(csv-kill-one-field field csv-killed-fields))
    (forward-line)))

(defun csv-kill-many-columns (fields)
  "Kill several fields in all lines in (narrowed) buffer.
FIELDS is an unordered list of field indices.
Save killed fields in increasing index order in `csv-killed-fields'.
Assumes point is at `point-min'.  Called by `csv-kill-fields'.
Ignore blank and comment lines."
  (if (eolp) (error "First record is empty"))
  ;; Convert non-positive to positive field numbers:
  (let ((last 1) (f fields))
    (csv-end-of-field)
    (while (not (eolp))
      (forward-char)			; skip separator
      (csv-end-of-field)
      (setq last (1+ last)))	     ; last = # fields in first record
    (while f
      (cond ((consp (car f))
	     ;; Expand a field range: (m.n) -> m m+1 ... n-1 n.
	     ;; If n is nil then it defaults to the number of fields.
	     (let* ((range (car f)) (cdrf (cdr f))
		    (m (car range)) (n (cdr range)))
	       (if (< m 0) (setq m (+ m last 1)))
	       (if n
		   (if (< n 0) (setq n (+ n last 1)))
		 (setq n last))
	       (setq range (list n))
	       (while (> n m) (push (setq n (1- n)) range))
	       (setcar f (car range))
	       (setcdr f (cdr range))
	       (setcdr (setq f (last range)) cdrf)))
	    ((zerop (car f)) (setcar f 1))
	    ((< (car f) 0) (setcar f (+ f last 1))))
      (setq f (cdr f))))
  (goto-char (point-min))
  ;; Kill from right to avoid miscounting:
  (setq fields (sort fields '>))
  (while (not (eobp))
    (or (csv-not-looking-at-record)
	(let ((fields fields) killed-fields field)
	  (while fields
	    (setq field (car fields)
		  fields (cdr fields))
	    (beginning-of-line)
	    (csv-kill-one-field field killed-fields))
	  (push (mapconcat 'identity killed-fields (car csv-separators))
		csv-killed-fields)))
    (forward-line)))

(defun csv-yank-fields (field beg end)
  "Yank fields as the ARGth field of each line in the region.
ARG may be arbitrarily large and records are extended as necessary.
If not set, the region defaults to the CSV records around point\;
if point is not in a CSV record then offer to yank as a new table.
The fields yanked are those last killed by `csv-kill-fields'.
Fields are separated by `csv-separators' and null fields are allowed anywhere.
Field indices increase from 1 on the left or decrease from -1 on the right.
A prefix argument specifies a single field, otherwise prompt for field index.
Ignore blank and comment lines.  When called non-interactively, FIELD
is a single field index\; BEG and END specify the region to process."
  ;; (interactive "*P\nr")
  (interactive (condition-case err
		   (csv-interactive-args 'single)
		 (error (list nil nil err))))
  (barf-if-buffer-read-only)
  (if (null beg)
      (if (y-or-n-p (concat (error-message-string end)
			    ".  Yank as a new table? "))
	  (csv-yank-as-new-table)
	(error (error-message-string end)))
    (if (<= field 0) (setq field (1+ field)))
    (save-excursion
      (save-restriction
	(narrow-to-region beg end)
	(goto-char (point-min))
	(let ((fields csv-killed-fields))
	  (while (not (eobp))
	    (unless (csv-not-looking-at-record)
	      ;; Yank at start of specified field if possible,
	      ;; otherwise yank at end of record:
	      (if (zerop field)
		  (end-of-line)
		(csv-sort-skip-fields field 'yank))
	      (and (eolp) (insert (car csv-separators)))
	      (when fields
		(insert (car fields))
		(setq fields (cdr fields)))
	      (or (eolp) (insert (car csv-separators))))
	    (forward-line)))))))

(defun csv-yank-as-new-table ()
  "Yank fields as a new table starting at point.
The fields yanked are those last killed by `csv-kill-fields'."
  (interactive "*")
  (let ((fields csv-killed-fields))
    (while fields
      (insert (car fields) ?\n)
      (setq fields (cdr fields)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Aligning fields
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun csv-align-fields (hard beg end)
  "Align all the fields in the region to form columns.
The alignment style is specified by `csv-align-style'.  The number of
spaces specified by `csv-align-fields' appears after each separator.
Use soft alignment done by displaying virtual white space after the
separators unless invoked with an argument, in which case insert real
space characters into the buffer after the separators.
Unalign first (see `csv-unalign-fields').  Ignore blank and comment lines.

In hard-aligned records, separators become invisible whenever
`buffer-invisibility-spec' is non-nil.  In soft-aligned records, make
separators invisible if and only if `buffer-invisibility-spec' is
non-nil when the records are aligned\; this can be changed only by
re-aligning.  \(Unaligning always makes separators visible.)

When called non-interactively, use hard alignment if HARD is non-nil\;
BEG and END specify the region to align."
  (interactive (csv-interactive-args))
  (setq end (set-marker (make-marker) end))
  (csv-unalign-fields hard beg end) ; if hard then barfs if buffer read only
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (set-marker end nil)
      (goto-char (point-min))
      (let (widths)
	;; Construct list of column widths:
	(while (not (eobp))		; for each record...
	  (or (csv-not-looking-at-record)
	      (let ((w widths) x)
		(setq beg (point))	; beginning of current field
		(while (not (eolp))
		  (csv-end-of-field)
		  (setq x (- (point) beg)) ; field width
		  (if w
		      (if (> x (car w)) (setcar w x))
		    (setq w (list x)
			  widths (nconc widths w)))
		  (or (eolp) (forward-char)) ; skip separator
		  (setq w (cdr w)
			beg (point)))))
	  (forward-line))

	;; Align fields:
	(goto-char (point-min))
	(while (not (eobp))		; for each record...
	  (or (csv-not-looking-at-record)
	      (let ((w widths) (padding 0) x)
		(setq beg (point))	; beginning of current field
		(while (and w (not (eolp)))
		  (let ((left-padding 0) (right-padding 0) overlay)
		    (csv-end-of-field)
		    (set-marker end (point)) ; end of current field
		    (setq x (- (point) beg) ; field width
			  x (- (car w) x)) ; required padding

		    ;; beg = beginning of current field
		    ;; end = (point) = end of current field

		    ;; Compute required padding:
		    (cond
		     ((eq csv-align-style 'left)
		      ;; Left align -- pad on the right:
		      (setq left-padding csv-align-padding
			    right-padding x))
		     ((eq csv-align-style 'right)
		      ;; Right align -- pad on the left:
		      (setq left-padding (+ csv-align-padding x)))
		     ((eq csv-align-style 'auto)
		      ;; Auto align -- left align text, right align numbers:
		      (if (string-match "\\`[-+.[:digit:]]+\\'"
					(buffer-substring beg (point)))
			  ;; Right align -- pad on the left:
			  (setq left-padding (+ csv-align-padding x))
			;; Left align -- pad on the right:
			(setq left-padding csv-align-padding
			      right-padding x)))
		     ((eq csv-align-style 'centre)
		      ;; Centre -- pad on both left and right:
		      (let ((y (/ x 2))) ; truncated integer quotient
			(setq left-padding (+ csv-align-padding y)
			      right-padding (- x y)))))

		    (if hard
			;; Hard alignment...
			(progn
			  (when (> left-padding 0) ; pad on the left
			    ;; Insert spaces before field:
			    (if (= beg end) ; null field
				(insert (make-string left-padding ?\ ))
			      (goto-char beg) ; beginning of current field
			      (insert (make-string left-padding ?\ ))
			      (goto-char end))) ; end of current field
			  (unless (eolp)
			    (if (> right-padding 0) ; pad on the right
				;; Insert spaces after field:
				(insert (make-string right-padding ?\ )))
			    ;; Make separator (potentially) invisible;
			    ;; in Emacs 21.3, neighbouring overlays
			    ;; conflict, so use the following only
			    ;; with hard alignment:
			    (overlay-put (make-overlay (point) (1+ (point)))
					 ;; 'face 'secondary-selection) ; test
					 'invisible t)
			    (forward-char))) ; skip separator

		      ;; Soft alignment...

		      (if buffer-invisibility-spec ; csv-hide-separators

			  ;; Hide separators...
			  (progn
			    ;; Merge right-padding from previous field
			    ;; with left-padding from this field:
			    (setq padding (+ padding left-padding))
			    (when (> padding 0)
			      (goto-char beg) ; beginning of current field
			      (if (bolp)
				  ;; Display spaces before first field
				  ;; by overlaying first character:
				  (overlay-put
				   (make-overlay (point) (1+ (point)))
				   'before-string
				   (make-string padding ?\ ))
				;; Display separator as spaces:
				(overlay-put
				   (make-overlay (1- (point)) (point))
				   ;; 'face 'secondary-selection)) ; test
				   ;; 'display (make-string padding ?\ )))
				   ;; Above 'display mangles buffer
				   ;; horribly if any string is empty!
				   'display `(space :width ,padding)))
			      (goto-char end)) ; end of current field
			    (unless (eolp)
			      (setq padding right-padding)
			      (forward-char))) ; skip separator

			;; Do not hide separators...
			(when (> left-padding 0) ; pad on the left
			  ;; Display spaces before field:
			  (setq overlay (make-overlay beg (point)))
			  (overlay-put overlay 'before-string
				       (make-string left-padding ?\ )))
			(unless (eolp)
			  (if (> right-padding 0) ; pad on the right
			      ;; Display spaces after field:
			      (overlay-put
			       (or overlay
				   (make-overlay beg (point)))
			       'after-string (make-string right-padding ?\ )))
			  (forward-char))) ; skip separator

		      ))

		  (setq w (cdr w)
			beg (point)))))
	  (forward-line)))))
  (set-marker end nil))

(defun csv-unalign-fields (hard beg end)
  "Undo soft alignment and optionally remove redundant white space.
Undo soft alignment introduced by `csv-align-fields'.  If invoked with
an argument then also remove all spaces and tabs around separators.
Also make all invisible separators visible again.
Ignore blank and comment lines.  When called non-interactively, remove
spaces and tabs if HARD non-nil\; BEG and END specify region to unalign."
  (interactive (csv-interactive-args))
  ;; Remove any soft alignment:
  (mapc 'delete-overlay	(overlays-in beg end))
  (when hard
    (barf-if-buffer-read-only)
    ;; Remove any white-space padding around separators:
    (save-excursion
      (save-restriction
	(narrow-to-region beg end)
	(goto-char (point-min))
	(while (not (eobp))
	  (or (csv-not-looking-at-record)
	      (while (not (eolp))
		;; Delete horizontal white space forward:
		;; (delete-horizontal-space)
		;; This relies on left-to-right argument evaluation;
		;; see info node (elisp) Function Forms.
		(delete-region (point)
			       (+ (point) (skip-chars-forward " \t")))
		(csv-end-of-field)
		;; Delete horizontal white space backward:
		;; (delete-horizontal-space t)
		(delete-region (point)
			       (+ (point) (skip-chars-backward " \t")))
		(or (eolp) (forward-char))))
	  (forward-line))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Transposing rows and columns
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun csv-transpose (beg end)
  "Rewrite rows (which may have different lengths) as columns.
Null fields are introduced as necessary within records but are
stripped from the ends of records.  Preserve soft alignment.
This function is its own inverse.  Ignore blank and comment lines.
When called non-interactively, BEG and END specify region to process."
  ;; (interactive "*P\nr")
  (interactive (csv-interactive-args 'noarg))
  (barf-if-buffer-read-only)
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      ;; Delete rows and collect them as a reversed list of lists of
      ;; fields, skipping comment and blank lines:
      (let ((sep (car csv-separators))
	    (align (overlays-in beg end))
	    rows columns)
	;; Remove soft alignment if necessary:
	(when align
	  (mapc 'delete-overlay	align)
	  (setq align t))
	(while (not (eobp))
	  (if (csv-not-looking-at-record)
	      ;; Skip blank and comment lines:
	      (forward-line)
	    (let ((lep (line-end-position)))
	      (push
	       (csv-split-string
		(buffer-substring-no-properties (point) lep)
		csv-separator-regexp nil t)
	       rows)
	      (delete-region (point) lep)
	      (or (eobp) (delete-char 1)))))
	;; Rows must have monotonic decreasing lengths to be
	;; transposable, so ensure this by padding with null fields.
	;; rows is currently a reversed list of field lists, which
	;; must therefore have monotonic increasing lengths.
	(let ((oldlen (length (car rows))) newlen
	      (r (cdr rows)))
	  (while r
	    (setq newlen (length (car r)))
	    (if (< newlen oldlen)
		(nconc (car r) (make-list (- oldlen newlen) nil))
	      (setq oldlen newlen))
	    (setq r (cdr r))))
	;; Collect columns as a reversed list of lists of fields:
	(while rows
	  (let (column (r rows) row)
	    (while r
	      (setq row (car r))
	      ;; Provided it would not be a trailing null field, push
	      ;; field onto column:
	      (if (or column (string< "" (car row)))
		  (push (car row) column))
	      ;; Pop field off row:
	      (setcar r (cdr row))
	      ;; If row is now empty then remove it:
	      (or (car r) (setq rows (cdr rows)))
	      (setq r (cdr r)))
	    (push column columns)))
	;; Insert columns into buffer as rows:
	(setq columns (nreverse columns))
	(while columns
	  (insert (mapconcat 'identity (car columns) sep) ?\n)
	  (setq columns (cdr columns)))
	;; Re-do soft alignment if necessary:
	(if align (csv-align-fields nil (point-min) (point-max)))))))

;; The following generalised version of `split-string' is taken from
;; the development version of WoMan and should probably replace the
;; standard version in subr.el.  However, CSV mode (currently) needs
;; only the `allowbeg' option.

(defun csv-split-string
  (string &optional separators subexp allowbeg allowend)
  "Splits STRING into substrings where there are matches for SEPARATORS.
Each match for SEPARATORS is a splitting point.
The substrings between the splitting points are made into a list
which is returned.
If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\".
SUBEXP specifies a subexpression of SEPARATORS to be the splitting
point\; it defaults to 0.

If there is a match for SEPARATORS at the beginning of STRING, we do
not include a null substring for that, unless ALLOWBEG is non-nil.
Likewise, if there is a match at the end of STRING, we do not include
a null substring for that, unless ALLOWEND is non-nil.

Modifies the match data; use `save-match-data' if necessary."
  (or subexp (setq subexp 0))
  (let ((rexp (or separators "[ \f\t\n\r\v]+"))
	(start 0)
	notfirst
	(list nil))
    (while (and (string-match rexp string
			      (if (and notfirst
				       (= start (match-beginning subexp))
				       (< start (length string)))
				  (1+ start) start))
		(< (match-beginning subexp) (length string)))
      (setq notfirst t)
      (or (and (not allowbeg) (eq (match-beginning subexp) 0))
	  (and (eq (match-beginning subexp) (match-end subexp))
	       (eq (match-beginning subexp) start))
	  (push (substring string start (match-beginning subexp)) list))
      (setq start (match-end subexp)))
    (or (and (not allowend) (eq start (length string)))
	(push (substring string start) list))
    (nreverse list)))

(provide 'csv-mode)

;;; csv-mode.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/tc.el0000775000000000000000000013152512230377266020206 0ustar  ;;; trivial-cite -- cite text with proper filling
;; 
;; TrivialCite v0.13.4
;; This is my attempt at making a sensible citer.
;;
;; This program is copyright (c) 1998 Lars R. Clausen
;;
;; Time-stamp: <2003-05-14 16:21:59 lrclause>
;; 
;; Author: Lars R. Clausen 
;; Created: March 1998
;; Keywords: Citing, filling, mail, news
;; X-URL: http://shasta.cs.uiuc.edu/~lrclause/tc.html
;;
;; trivial-cite 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 2, or (at your option)
;; any later version.

;; trivial-cite 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 trivial-cite; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;; 
;; Trivial-Cite is an Emacs package with the same purpose as Supercite:
;; Cite text for mail and posting, but with different
;; objectives.  Trivial-Cite tries hard to do the following correctly:
;; 
;;    1. Fill paragraphs of previously cited text correctly, even when
;;       encountering strange citing marks.
;;    2. Parse the cited headers to allow attribution in a configurable way.
;;    3. Allow the user to undo formatting.
;;    4. Remove the signature as the last undoable action.
;;    5. Allow the user to cite and fill cited text in other contexts.
;;    6. Fix odd-looking citemarks to look nice (optional with
;;       `tc-normalize-cite-marks').
;; 
;; Furthermore, it follows the suggestions of Son-of-RFC1036 and cites with
;; a >, and sensibly so.
;; 
;; No, I will not make it quote with name abbreviations like SuperCite does.
;; That style is annoying and unreadable, goes against the RFC's (or rather,
;; the sons of them:), and have generally been the most problematic thing to
;; deal with.  Trivial-cite can handle them, but is better at 'normal'
;; citation marking.
;;
;; To use, add the following to your .emacs:
;;
;; (autoload 'trivial-cite "tc" t t)
;;
;; ;; For Gnus:
;;
;; (setq message-cite-function 'trivial-cite)
;;
;; ;; For MH-E
;; (add-hook 'mail-citation-hook 'trivial-cite)
;; (setq mh-yank-from-start-of-msg t)
;; ;; -> then use `C-cC-y' in your draft.

;; TODO: Good way to undo fillings without mouse.
;;       More funny functions:)
;;       Add space after cite-marks if old citing doesn't have it?
;;       Make tc-fill-cited-paragraph faster by re-inserting all at once.
;;       Generally optimize -- font-lock wastes time.
;;       Some simpler way to generate attributions?
;;       Follow Stallmans advice:  Better docs, what's different from
;;         SuperCite, better comments, how is the filling different
;;         from standard Emacs filling.

;; Reminder:
;; When mail-citation-hook is run, the cite is in current-buffer, (point) at
;; start and (mark t) at end.

;;; Code:

;;; ************************************************************
;;; External requirements here
;;; ************************************************************

(require 'mail-extr)
(if (featurep 'xemacs)
    (require 'overlay))

;;; ************************************************************
;;; Meta-parameters here
;;; ************************************************************

(defconst tc-maintainer "lrclause@cs.uiuc.edu")

(defconst tc-version "0.13.3")

(defvar tc-debug-level 0
  "How much debugging output `trivial-cite' should give.")

;;; ************************************************************
;;; Normal user-settable parameters here
;;; ************************************************************

(defgroup tc nil "Insert cited text in a nice manner")

(defcustom tc-remove-signature "^\\(-- \\|--\\)$"
  "If non-nil, specify a regexp that finds the signature divider.
The lines below the first match of this regexp will be removed, but
immediately available in the undo buffer.  If nil, the signature will
not be removed."
  :type 'regexp
  :group 'tc)

(defcustom tc-fill-column t
  "If t means attempt to fill paragraphs with long lines.
Trivial-cite attempts to guess citation marks and fill the cited
paragraphs accordingly, when there are lines of more than `fill-column'
characters including citation marks.  If you wish to undo the
filling, each paragraph filling can be undone with
\\[tc-unfill-paragraph].
An integer argument means wrap at that column instead of at `fill-column'"
  :type '(radio (const :tag "Fill at `fill-column'" t)
		(integer :tag "Fill at this column")
		(const :tag "Don't fill" nil))
  :group 'tc)

(defcustom tc-mouse-overlays nil
  "Non-nil means mark filled paragraphs with a mouse overlay.
Right-clicking such an overlay toggles filling of that paragraph,
like with \\[tc-unfill-paragraph]."
  :type 'boolean
  :group 'tc)

; Not ready yet
; (defcustom tc-cleanup-cited-marks nil
;   "Non-nil means uniform citation marks are substituted in cited text.
; Thus any sequence of cite-marks such as \"> |: }\" will be replace with a
; uniform string of the citemarks of your choice, e.g. \">>>> \"."
;   :type 'boolean
;   :group 'tc)

(defcustom tc-make-attribution 'tc-simple-attribution
  "The function used to generate a attribution for a citation.
`tc-simple-attribution' is primitive, but easy to use.
`tc-tiny-attribution' is a minimal attribution.
`tc-simple-attribution-kai' uses the real name if found.
`tc-fancy-attribution' can be used to personalize the attribution."
  :type '(radio
          (const :tag "On 3 Sep 2003, email wrote:" tc-simple-attribution)
          (const :tag "Real Name wrote:"   tc-tiny-attribution)
          (const :tag "Real Name  wrote:"
                 tc-attribution-name-and-email-wrote)
          (const :tag "On 3 Sep 2003, Real Name wrote:"
                 tc-simple-attribution-kai)
          (const :tag "On 3 Sep 2003, Real Name spake thusly:"
                 tc-fancy-attribution)
          (function :tag "Other custom function"))
  :group 'tc)

(defcustom tc-time-format "%e %b %Y"
  "The time format used for the date part in the attribution.
The date is taken from the header fields.  The format is passed to
`format-time-string', see that function for more information."
  :type 'string
  :group 'tc)

(defcustom tc-normal-citemarks ">"
  "The characters that should always be considered citation marks.
This would normally just be '>', but if you often cite text with other
regular characters used for citing, you can ease the life for both
`trivial-cite' and yourself by adding them here."
  :type 'string
  :group 'tc)

(defcustom tc-guess-cite-marks 'ask
  "*Non-nil means try to guess at non-standard cite-marks.
The guess it made from a list of characters `tc-guess-marks-regexp'
which might be used for it.  If the value is 'ask, trivial-cite will
ask if the marks found are correct."
  :type '(choice (const nil) (const t) (const ask))
  :group 'tc)

(defcustom tc-guess-marks-regexp "\\=[]>};:|#$@ ]*[]>};:|#$@]"
  (concat "The regexp used for guessing at non-standard cite-marks.
If you see anyone using other characters (not alphanumeric) for citing,
plese tell " tc-maintainer " so they can be added to the list in the
distribution.")
  :type 'regexp
  :group 'tc)

(defcustom tc-normalize-cite-marks t
  "Non-nil means normalize other peoples citation marks to match yours."
  :type 'boolean
  :group 'tc)

(defcustom tc-citation-string ">"
  "The string that `trivial-cite' inserts to make a citation.
The standard string (as noted in son-of-RFC1036) is '>'.  You should
not change this, as that makes it more difficult for citers (even
`trivial-cite') to identify citings correctly.  An extra space is
inserted after the string, if the cited text does not seem to be cited
already.  See `tc-normal-citemarks' and `tc-guess-marks-regexp' for
how cite marks are found."
  :type 'string
  :group 'tc)

(defcustom tc-gnus-nntp-header-hack nil
  "Non-nil means check for Gnus 5.8.7 odd header insertion.
Gnus 5.8.7 inserts an NNTP header line that's odd (haven't seen it myself,
but got a report from  about it),
and this hack removes the line.  It may conceivably do damage to other lines,
too, so I'm looking for a better solution."
  :type 'boolean
  :group 'tc)

(defcustom tc-pre-hook nil
  "*Hook called in the very beginning of `trivial-cite'."
  :type 'hook
  :group 'tc)

(defcustom tc-post-hook nil
  "*Hook called in the very end of `trivial-cite'."
  :type 'hook
  :group 'tc)

;;; ************************************************************
;;; Functions that parse the cited headers to allow attribution.
;;; ************************************************************

(defvar tc-strings-list ()
  "An association list containing the parsed headers.
Typical entries are (\"subject\".\"Re: tc bug\"), (\"real-name\".\"John Doe\"),
\(\"email-addr\".\"elascurn@daimi.aau.dk\") etc., but there is no fixed
format.")

(defvar tc-header-funs
  (list
   (cons "From" 'tc-parse-from)
   ;; The Subject: field - just put text into tc-strings-list
   (cons "Subject" '(lambda (x)
		      (setq tc-strings-list
			    (cons (cons "subject" x) tc-strings-list))))
   (cons "Date" 'tc-parse-date)
   (cons "Newsgroups" 'tc-parse-groups))
  "An association list used by `trivial-cite'.
It contains the various functions for decoding headers.  The function gets
a string as argument, which is the contents of that header (possibly
including newlines, but excluding starting spaces).  Any return value is
ignored.  `tc-strings-list' is an association list destined to hold the
parsed data."  )

;; parse the headers in the quote, calling funcs
(defun tc-parse-headers ()
  "Parse the headers of a mail message.
Also calls the functions defined in `tc-header-funs' on the respective
fields."
  ;; Still a header here?
  (let ((header-start (point)))
    (if tc-gnus-nntp-header-hack
	;; From , to deal with
	;; Gnus 5.8.7 putting the NNTP header into the buffer
	(while (looking-at "2[0-9][0-9] ")
	  (delete-region (point) (progn (forward-line 1) (point)))
	  (setq header-start (point))))
    (while (not (looking-at "\012"))
      ;; Find field name
      (if (not (looking-at "\\\([!-9;-~]+\\\):[ ]*\\\([^ ]?.*\\\)"))
	  (message "Malformed field")
	(let
	    ((field-name (buffer-substring-no-properties
			  (match-beginning 1) (match-end 1)))
	     (field-contents (buffer-substring-no-properties
			      (match-beginning 2) (match-end 2))))
	  ;; Unfold
	  (forward-line 1)
	  (while (looking-at "[ \011]")
	    (let ((beg (point)))
	      (end-of-line)
	      (setq field-contents (concat field-contents
					   (buffer-substring-no-properties
					    beg (point))))
	      (forward-line 1)))

          (if (string-match "[^ \011].*$" field-contents)
              (setq field-contents
                    (substring field-contents
                               (match-beginning 0)))
	    (setq field-contents ""))
	  
	  ;; Find function for this field name
	  (let ((field-func (assoc field-name tc-header-funs)))
	    (if field-func
		(progn
		  (setq field-func (cdr field-func))
		  (funcall field-func field-contents)))))))

    (forward-line 1);; Skip past one blank line seperating headers and body
    (delete-region header-start (point))))

;;; Functions to parse individual headers into appropriate structures here

(defun tc-parse-date (str)
  "Use `tc-time-format' to parse the date STR for use in attributions.
The resulting string is inserted into `tc-strings-list'."
  (let* ((time (date-to-time str))
	 (date (format-time-string tc-time-format time)))
    (setq tc-strings-list (cons (cons "date" date) tc-strings-list))))

;; Parse a From:-style field from str into tc-strings-list under key
(defun tc-parse-from (str)
  "Use mail-extr to get email-addr and real-name into `tc-strings-list' from STR."
  (if (> tc-debug-level 0)
      (message "%s" (concat "Parsing from string '" str "'")))
  (let ((names (mail-extract-address-components str)))
    (if names
	(progn
	  (if (car names)
	      (setq tc-strings-list (cons (cons "real-name" (car names))
					  tc-strings-list)))
	  (if (car (cdr names))
	      (setq tc-strings-list (cons (cons "email-addr" (car (cdr names)))
					  tc-strings-list)))))))

(defun tc-parse-groups (str)
  (if (> tc-debug-level 0)
      (message "%s" (concat "Parsing groups string '" str "'")))
  (let ((pos 0)
	groups)
    (while (string-match ",[ \012]*" str pos)
      (setq groups (cons (substring str pos (1- (match-end 0))) groups))
      (setq pos (match-end 0)))
    (setq tc-strings-list
	  (cons (cons "newsgroups"
		      (nreverse (cons (substring str pos (length str))
				      groups)))
		tc-strings-list))))

;;; Functions to make various default attributions here
;; My simple (but nice:) attribution function
(defun tc-simple-attribution ()
  "Make an attribution from email address and date."
  (let ((date (assoc "date" tc-strings-list))
	(name (assoc "email-addr" tc-strings-list)))
    (if (null name)
	"An unnamed person wrote:\n\n"
      (if (null date)
	  (concat (cdr name) " wrote:\n\n")
	(concat "On " (cdr date) ", " (cdr name) " wrote:\n\n")))))

(defun tc-attribution-name-and-email-wrote ()
  "Produce attribution string, using the real name and email address."
  (let ((email (assoc "email-addr" tc-strings-list))
        (realname (assoc "real-name" tc-strings-list)))
    (cond
     ((and (null realname)(null email))
      "An unnamed person wrote:\n\n")
     ((null realname)
      (format "%s wrote:\n\n" (cdr email)))
     (t
      (format "%s <%s> wrote:\n\n" (cdr realname) (cdr email))))))

;; A simple attribution by Kai Grojohann 
(defun tc-simple-attribution-kai ()
  "Produce the standard attribution string, using the real name."
  (let ((date (assoc "date" tc-strings-list))
	(email (assoc "email-addr" tc-strings-list))
        (name (assoc "real-name" tc-strings-list)))
    (if (and (null name) (null email))
	"An unnamed person wrote:\n\n"
      (if (null date)
	  (concat (cdr (or name email)) " wrote:\n\n")
	(concat "On " (cdr date) ", " (cdr (or name email)) " wrote:\n\n")))))

;; A very small attribution, using real name or email
(defun tc-tiny-attribution ()
  "Produce a very small attribution string."
  (let ((email (assoc "email-addr" tc-strings-list))
        (name (assoc "real-name" tc-strings-list)))
    (concat (cdr (or name email '(t . "Somebody"))) " wrote:\n\n")))

;;; ************************************************************
;;; Deal with the signature and other minor fuzz.
;;; ************************************************************

;; Normally, the signature should be removed, if we can find
;; it.  But we want it to be ready for the first undo.
(defvar tc-removed-sig nil
  "The signature removed from the last mailing.")
(defvar tc-removed-sig-marker nil
  "Marks the place where the signature was removed from the last mailing.")

(defun tc-do-remove-sig ()
  "Attempt to remove the signature from already quoted text.
Warns if it is longer than 4 lines (5 including signature mark '-- ')."
  (save-excursion
    (setq tc-removed-sig nil)
    (setq tc-removed-sig-marker nil)
    (exchange-point-and-mark)
    (let ((msgend (point)))
      (if (re-search-backward tc-remove-signature 0 t)
	  ;; Found it
	  (let ((lines (count-lines (point) msgend)))
	    (setq tc-removed-sig (buffer-substring (point) msgend))
	    (delete-region (point) msgend)
	    (setq tc-removed-sig-marker (point-marker))
	    (if (> lines 5);; Remember to include the '-- ' mark
		(message (concat "Signature was very large ("
				 (int-to-string (- lines 1)) " lines)."))))))))

(defun tc-fix-signature-undo ()
  "Make the signature be after filling in undo list, and quoted."
  (if tc-removed-sig
      (progn
	(save-excursion
	  (goto-char (marker-position tc-removed-sig-marker))
	  (insert tc-removed-sig)
	  (let ((sig-end (point-marker)))
	    (goto-char (marker-position tc-removed-sig-marker))
	    (while (< (point) (marker-position sig-end))
	      (insert tc-citation-string " ")
	      (forward-line 1)))
	  (undo-boundary)
	  (delete-region (marker-position tc-removed-sig-marker)
			 (point))))))

;; Simple nested indentation, as defined in son-of-rfc1036 (plus one space
;; after > before non-cited text for readability).

(defvar tc-cite-marks nil
  "Cite-marks that are recognised by trivial-cites functions.
These are deleted after each citing.")

;; Give some extra characters that have been used for indention, so we know
;; to handle them.
(defun tc-extra-cite-marks (str)
  "Specify extra cite-marks STR (apart from '>') that are used for citing.
They remain valid for one citing only."
  (interactive "sExtra cite-marks: ")
  (if (not (equal str ""))
      (setq tc-cite-marks str)))

;; Thanks to Matthias Wiehl for this function
(defun tc-cleanup-cite-marks (start end)
  "Substitute uniform citation marks in the region between START and END.
Replaces any sequence of cite-marks such as \"> |: }\" with a uniform string
of the citemarks of your choice, e.g. \">>>> \"."
  (interactive "r")
  (save-excursion
    (goto-char start)
    (let ((end-marker (set-marker (make-marker) end)))
      (while (< (point) (marker-position end-marker))
	(if (looking-at " ")
	    (delete-char 1)
	  (if (looking-at (concat "[" tc-cite-marks "]"))
	      (progn
		(insert tc-citation-string)
		(delete-char 1))
	    (progn
	      (if (and (not (eq (preceding-char) ?\ ))
		       (not (looking-at "$")))
		  (insert " "))
	      (forward-line 1))))))))

(defun tc-indent-citation ()
  "Indent the current region with `tc-citation-string'.
It inserts an extra space before text that is not already cited (with
`tc-cite-marks'), except on empty lines (to avoid dangling space)."
  (while (< (point) (mark t))
    (cond ((re-search-forward (concat "[" tc-cite-marks "]") (1+ (point)) t)
	   (forward-char -1)
	   (insert tc-citation-string))
	  ((looking-at "^$")
	   (insert tc-citation-string))
	  (t (insert tc-citation-string " ")))
    (forward-line 1)))

(defun tc-remove-trailing-whitespace ()
  "Remove trailing whitespace."
  ;; First remove trailing empty lines
  (save-excursion
    (if (< (point) (mark t))
	(exchange-point-and-mark))
    (let ((end-cite (point)))
      (re-search-backward "[^ \t\n]" 0 t);; Skip empty lines
      (forward-line 1);; Whoops, got one line too far
      (delete-region (point) end-cite))))

(defun tc-combine-cite-marks (cm1 cm2)
  "Combine two sets of cite-marks so that there are no duplicates.
In fact, it checks if CM1 contains CM2, and if not, makes it so."
  (if (not (string-match (regexp-quote cm1) cm2))
      (concat cm1 cm2)
    cm1))

(defvar tc-old-yank nil)

(defvar tc-prefix-max-lines t
  "If t, `message-yank-original' takes a prefix max number of lines.")

; (defun tc-message-yank-original (&optional lines)
;   "Insert the message being replied to, if any.
; Puts point before the text and mark after.
; Indents the text using trivial-cite (cv).
; A numeric prefix is the maximal number of (body) lines to cite.

; This function uses `message-cite-function' to do the actual citing.
; "
;   (interactive "P")
;   (message (concat "Prefix is '" lines "'"))
;   (if lines
;       (setq tc-max-lines lines)
;     (setq tc-max-lines nil))
;   (tc-old-yank))

;; Replace the normal message-yank-original with a version that uses
;; the prefix to limit the number of lines.  Somewhat of a hack, but I like to
;; be able to do this:)
;; Now uses advice
(if tc-prefix-max-lines
    (defadvice message-yank-original (before max-lines-advice first (&optional lines) activate)
      "A numeric prefix is the maximal number of (body) lines to cite.
"
      (interactive "P")
      (if lines
	  (setq tc-max-lines lines)
	(setq tc-max-lines nil))
      (setq lines nil) ; Make message-yank-original happy
      ))

(defvar tc-max-lines nil
  "*Maximum number of lines that should be quoted by `trivial-cite'.
If `tc-max-lines-reset' is non-nil (the default), `tc-max-lines' is set to nil
\(meaning no limit) after each cite.")

(defvar tc-max-lines-reset t
  "*Whether `tc-max-lines' should be reset after use.
Normally, `tc-max-lines' is set to limit the citation of very long mails (e.g.
citations).")

(defun tc-indent-region (start end)
  "*Cite the region like `trivial-cite', but without parsing headers.
Doesn't cut the signature either.  Region is between START and END."
  (interactive "r")
  (save-excursion
    (if (> start end)
	(let ((tmp start)) (setq start end) (setq end tmp)))
    (goto-char start)
    (set-mark end)
    (setq tc-strings-list ())
    ;; Get the correct set of cite-marks, guessing if necessary
    ;; (delayed until now to allow sig to be removed)
    (if tc-cite-marks
	(setq tc-cite-marks (tc-combine-cite-marks
			     tc-normal-citemarks tc-cite-marks))
      (if tc-guess-cite-marks
	  (setq tc-cite-marks (tc-combine-cite-marks
			       tc-normal-citemarks (tc-guess-cite-marks)))
	(setq tc-cite-marks tc-normal-citemarks)))
    ;; Escape any cite-marks that would cause problems in a regexp
    (setq tc-cite-marks (tc-escape-char-range tc-cite-marks))
    ;; Do the actual citation
    (tc-indent-citation)
    ;; Normalize cite marks if so wanted
    (if tc-normalize-cite-marks
	(tc-cleanup-cite-marks start end))
    ;; Fill paragraphs
    (if tc-fill-column
	(tc-fill-cited-text start end))
    (setq tc-cite-marks nil)))

(defun tc-fix-final-newline ()
  "Add a newline if there is not one at the end of the cited text."
  (save-excursion
    (exchange-point-and-mark)
    (if (not (bolp))
	(insert "\n"))))

;;; ************************************************************
;;; The main citation engine
;;; ************************************************************
;;;###autoload
(defun trivial-cite ()
  "A simple citation function for use in news/mailreaders.
It parses the headers via the functions defined in `tc-header-funs', then
makes a attribution for the citation using `tc-make-attribution' and indents
the inserted text with `tc-indent-citation'.
Numeric prefix arguments is how many lines of body to cite (useful for citing
mails with long attachments).
Usage:  (auto-load 'trivial-cite \"tc\" t t)
        (add-hook 'mail-citation-hook 'trivial-cite)
Bugs:  Not very intelligent about old citation marks other than '>'.
Customization:  See variables tc-fill-column, tc-remove-signature,
tc-citation-string, tc-make-attribution and tc-header-funs."
  (run-hooks 'tc-pre-hook)
  (save-excursion
    (if (< (mark t) (point)) (exchange-point-and-mark))
    (let ((start (point)))
      ;; Initialize some fields
      (setq tc-strings-list ())
      ;; Allow undo to show the unformatted text
      (undo-boundary)
      (tc-fix-final-newline)
      ;; Parse the headers - assumes point at first header
      (tc-parse-headers)
      ;; Insert a attribution ("XXX wrote...:" etc)
      (if tc-make-attribution
	  (let ((start-marker (point-marker))
		(fill-prefix))
	    (insert (funcall tc-make-attribution))
	    (fill-region (marker-position start-marker) (point))
	    (setq start (point))))
      (tc-remove-trailing-whitespace)
      ;; Remove signature (if so wanted)
      (if tc-remove-signature
	  (tc-do-remove-sig))
      (tc-remove-trailing-whitespace)
      (if tc-max-lines
	  (save-excursion
	    (message (concat "Only citing "
			     (int-to-string tc-max-lines) " lines"))
	    (goto-char start)
	    (forward-line tc-max-lines)
	    (kill-region (point) (mark t))
	    (if tc-max-lines-reset (setq tc-max-lines nil))))
      ;; Get the correct set of cite-marks, guessing if necessary
      ;; (delayed until now to allow sig to be removed)
      (if tc-cite-marks
	  (setq tc-cite-marks (tc-combine-cite-marks
			       tc-normal-citemarks tc-cite-marks))
	(if tc-guess-cite-marks
	    (setq tc-cite-marks (tc-combine-cite-marks
				 tc-normal-citemarks (tc-guess-cite-marks)))
	  (setq tc-cite-marks tc-normal-citemarks)))
      ;; Escape any cite-marks that would cause problems in a regexp
      (setq tc-cite-marks (tc-escape-char-range tc-cite-marks))
      ;; Do the actual citation
      (tc-indent-citation)
      ;; Normalize cite marks if so wanted
      (if tc-normalize-cite-marks
	  (tc-cleanup-cite-marks start (mark-marker)))
      ;; Fill paragraphs
      (if tc-fill-column
	  (tc-fill-cited-text start (mark-marker)))
      (setq tc-cite-marks nil)
      (tc-fix-signature-undo)))
  (run-hooks 'tc-post-hook))

;;; ************************************************************
;;; Reformatting cited text
;;; ************************************************************

(defun tc-fill-column ()
  "Return the fill column that tc uses (explicit, `fill-column' or nil)."
  (cond ((integerp tc-fill-column) tc-fill-column)
	(tc-fill-column fill-column)
	(t nil)))

(defun tc-fill-cited-paragraphs (cite-len)
  "Fill cited paragraphs, keeping cite-marks in their correct places.
Used internally in tc-fill-cited-text.  Returns the end of the last filled
paragraph."
  (interactive "nLength of citation marks: ")
  (let (fill-end)
    (save-excursion
      (save-restriction
	(beginning-of-line)
	(let ((cite-marks (buffer-substring (point) (+ (point) cite-len)))
	      (fill-line (point)))
	  (if (>= tc-debug-level 1)
	      (message (concat "Citing marked with "
			       cite-marks ", extra marks are " tc-cite-marks)))
	  (let ((cite-regexp (concat "^" cite-marks
				     " *[^\n" tc-cite-marks " ]")))
	    ;; Look backward while properly cited
	    (while (and (not (bobp)) (looking-at cite-regexp))
	      (forward-line -1))
	    (if (not (looking-at cite-regexp))
		(forward-line 1))
	    (let ((cite-start (point))
		  (fill-column (- (tc-fill-column) cite-len)))
	      (goto-char fill-line)
	      (while (and (not (eobp)) (looking-at cite-regexp))
		(forward-line 1))
	      (if (looking-at cite-regexp)
		  (end-of-line))
	      (narrow-to-region cite-start (point))
	      (forward-line -1)
	      (forward-char cite-len)
	      (let ((cut-text (buffer-substring (point-min) (point-max))))
		(delete-extract-rectangle cite-start (point))
		(goto-char fill-line)
		(while (not (eobp))
		  (fill-paragraph nil)
		  (forward-paragraph))
		(goto-char cite-start)
		(while (not (eobp))
		  (insert cite-marks)
		  (forward-line 1))
		(setq fill-end (point))
		(let ((reformat-overlay
		       (make-overlay (point-min) (point-max))))
		  (overlay-put reformat-overlay
			       'tc-reformat (cons cut-text  reformat-overlay))
					     ;; Should check for mouse
		  (local-set-key "\C-c\C-p" 'tc-unfill-paragraph)
		  (if tc-mouse-overlays
		      (progn
			(overlay-put reformat-overlay
				     'mouse-face 'secondary-selection)
			(local-set-key [(shift button2)]
                                       'tc-unfill-paragraph-mouse))))))))))
    fill-end))

(defun tc-escape-char-range (str)
  "Escape any characters in STR that cause problems in a regexp char range.
This, is not the same as `regexp-quote', as we need to treat ^ and ] very
specially."
  (if (string-match "\\(-.*]\\|].*-\\)" str)
      ;; - and ] in a string -- got to seperate them
      (message "Can't have both - and ] in a regular expression (yet).")
    (when (string-match "-" str)
      ;; Move a "-" to start of the string
      (while (string-match "-" str)
        (setq str (replace-match "" nil nil str)))
      (setq str (concat "-" str)))
    (when (string-match "]" str)
      ;; Move a "]" to the start of the string
      (while (string-match "]" str)
        (setq str (replace-match "" nil nil str)))
      (setq str (concat "]" str)))
    (when (string-match "^\\^" str)
      ;; Move the "^" to not be at the start of the string
      (replace-match "" nil nil str)
      (setq str (concat str "^"))))
  str)

(defun tc-find-cite-len (p)
  "Find the length of the citation marking at point P.
This is so we can fix it when filling.
Used internally in `tc-fill-cited-text'."
  (save-excursion
    (goto-char p)
    (forward-line 1)
    (let ((forward-prefix-length (tc-line-common-prefix-length p (point))))
      (forward-line -2)
      (let ((backward-prefix-length (tc-line-common-prefix-length p (point))))
	(goto-char p)
	(beginning-of-line)
	(let ((prefix-length
	       (max forward-prefix-length backward-prefix-length))
	      (line-start (point)))
	  (end-of-line)
	  (let ((line-end (point)))
	    (beginning-of-line)
	    ;; Check if this is a one-line cite with good cite-marks
	    (if (and (re-search-forward
		      (concat "^[" tc-cite-marks " ]*["	tc-cite-marks "]["
			      tc-cite-marks " ]*") line-end t)
		     (> (- (match-end 0) (match-beginning 0)) prefix-length))
		(- (match-end 0) (match-beginning 0))
	      (forward-char prefix-length)
	      (if (re-search-backward
		   (concat "[" tc-cite-marks "][" tc-cite-marks " ]*")
		   line-start t)
		  (- (match-end 0) line-start)
		0))))))))

;; Find all lines that are too long and fill them
(defun tc-fill-cited-text (start end)
  "Fill all lines in region that are too long, keeping track of cite-marks.
Done on region between START and END.
Uses a seperate undo-mechanism (with overlays) to allow partial undo."
  (interactive "r")
  (save-excursion
    (goto-char start)
    (while (< (point) end)
      (beginning-of-line)
      (end-of-line)
      (if (> (current-column) (tc-fill-column))
	  (progn
	    (let ((cite-len (tc-find-cite-len (point))))
	      (if (> cite-len 0)
		  (if  (< cite-len (tc-fill-column))
		      (goto-char (tc-fill-cited-paragraphs cite-len))
		    (message (concat "Very long cite mark ("
				     (int-to-string cite-len) " chars)"))
		    (forward-line 1))
		(message (concat "Mysterious zero cite-len at "
				 (int-to-string (point))))
		(forward-line 1))))
	(forward-line 1)))))

;; A couple utility functions.

(defun tc-line-common-prefix-length (p1 p2)
  "Return the number of characters the two lines have as common prefix.
The two lines are at point P1 and P2."
  (save-excursion
    (let ((line1 (progn (goto-char p1) (beginning-of-line)
			(let ((line-start (point)))
			  (end-of-line)
			  (buffer-substring line-start (point)))))
	  (line2 (progn (goto-char p2) (beginning-of-line)
			(let ((line-start (point)))
			  (end-of-line)
			  (buffer-substring line-start (point))))))
      (tc-string-common-prefix-length line1 line2))))

(defun tc-string-common-prefix-length (s1 s2)
  "Return how many characters in S1 and S2 are equal."
  (let ((len (min (length s1) (length s2)))
	(x 0))
    (while (and (< x len)
		(equal (aref s1 x) (aref s2 x)))
      (setq x (1+ x)))
    x))

(defun tc-fill-cited-region (start end)
  "Fill all lines in the region, but keep the overall citation intact.
The region is between START and END.
This function assumes that all lines in the region have the same citation
marks, as it regards the shortest common prefix of the lines as citation
marks."
  (interactive "r")
;;(save-excursion
  (goto-char start)
  (beginning-of-line)
  (let ((line-start (point)))
    (end-of-line)
    (let ((cite-marks (buffer-substring line-start (point))))
      (forward-line 1)
      (while (< (point) end)
        (let ((other-line
               (buffer-substring (point) (+ (length cite-marks) (point)))))
          (if (not (string-equal cite-marks other-line))
              (setq cite-marks
                    (substring cite-marks 0
                               (tc-string-common-prefix-length
                                cite-marks other-line)))))
        (forward-line 1))
      (goto-char start)
      (save-restriction
        (narrow-to-region start end)
        (tc-fill-cited-paragraphs (length cite-marks))))))

(defun tc-fill-cited-region-uniformly (start end)
  "Fill all lines in the region, making the overall citation uniform.
The region is between START and END.
This function finds the longest possible citemark and wraps all lines as
if they had that amount of citemarks."
  (interactive "r")
;;(save-excursion
  (goto-char end)
  (let ((end-mark (point-marker))
	(cite-marks ""))
    (goto-char start)
    (beginning-of-line)
    (while (< (point) (marker-position end-mark))
      (end-of-line)
      (let ((line-end (point)))
	(beginning-of-line)
	(re-search-forward tc-guess-marks-regexp line-end t)
	(let ((marks-here (buffer-substring (match-beginning 0)
					    (match-end 0))))
	  (if (> (length marks-here) (length cite-marks))
	      (setq cite-marks marks-here))
	  (delete-region (match-beginning 0) (match-end 0))))
      (forward-line 1))
    (goto-char start)
    (beginning-of-line)
    (while (< (point) (marker-position end-mark))
      (insert cite-marks)
      (forward-line 1))
    (goto-char start)
    (save-restriction
      (narrow-to-region start (marker-position end-mark))
      (tc-fill-cited-paragraphs (length cite-marks)))))

(defun tc-unfill-paragraph-mouse (e)
  "Unfill the paragraph at mouse event E."
  (interactive "e")
  (if (eventp e)
      ;; Why do you have to disagree?  Grr.  Arg.
      (if (featurep 'xemacs)
	  (tc-unfill-paragraph (event-point e))
	(tc-unfill-paragraph (posn-point (event-start e)))))
;;  (tc-unfill-paragraph (car (cdr (car (cdr e)))))
  )

(defun tc-unfill-paragraph (at)
  "Undo filling of cited text in the paragraph containing point AT.
Calling the function several times will toggle the paragrap between
the filled and the unfilled version.  `tc-fill-cited-region' may be able
to fill the paragraph better."
  (interactive "d")
  (let ((reformatted (get-char-property at 'tc-reformat)))
    (if reformatted
	(save-excursion
	  (let ((removed-region (buffer-substring
				 (overlay-start (cdr reformatted))
				 (overlay-end (cdr reformatted)))))
	    (goto-char (overlay-start (cdr reformatted)))
	    (insert (car reformatted))
	    (delete-region (point)
			   (overlay-end (cdr reformatted)))
	    (setcar reformatted removed-region)))
      (message "No formatted paragraph here."))))

;;; ************************************************************
;;; Guessing at the right set of citation marks
;;; ************************************************************
(defun tc-trim-best-prefix (prefix)
  "Remove from the PREFIX newlines, known marks and duplicates."
  (let ((known-marks (concat "\n " tc-normal-citemarks))
	(i 0))
    (while (< i (length prefix))
      (if (not (string-match (regexp-quote (substring prefix i (1+ i)))
			     known-marks))
	  (setq known-marks (concat known-marks (substring prefix i (1+ i)))))
      (setq i (1+ i)))
    (substring known-marks (length (concat "\n " tc-normal-citemarks)))))

(defun tc-guess-cite-marks ()
  (save-excursion
    (let ((best-prefix "\n")
	  guessed-marks
	  marks-begin marks-end)
      (while (search-forward best-prefix (mark t) t)
	(let ((prefix-start (match-beginning 0)))
	  (if (re-search-forward tc-guess-marks-regexp nil t)
	      (progn
		(setq marks-begin prefix-start)
		(setq marks-end (match-end 0))
		(setq best-prefix (buffer-substring marks-begin marks-end))
		(if (> tc-debug-level 0)
		    (message best-prefix))))))
      (setq guessed-marks (tc-trim-best-prefix best-prefix))
      (if (and (eq tc-guess-cite-marks 'ask)
	       (not (equal "" guessed-marks)))
	  (let ((marks-overlay (make-overlay (1+ marks-begin) marks-end)))
	    (overlay-put marks-overlay 'face 'highlight)
	    (setq guessed-marks
		  (read-from-minibuffer
		   "Guessed these citemarks: " guessed-marks))
	    (delete-overlay marks-overlay)))
      guessed-marks)))

(defun tc-citemarks-need-guessing ()
  (save-excursion
    (let ((max-line-len (- (tc-fill-column) (length tc-citation-string) 1))
	  needed)
      (beginning-of-line)
      (while (and (not needed)
		  (< (point) (mark t)))
	(end-of-line)
	(if (> (current-column) max-line-len)
	      (setq needed t))
	(forward-line 1))
      needed)))

;;; ************************************************************
;;; More fancy attribution generation functions
;;; ************************************************************

;; Doesn't work yet.  *sniff*
(defun tc-reply-to-citee-p (email)
  "Whether the mail being composed is for the person being cited."
  (save-excursion
    (beginning-of-buffer)
    (if (re-search-forward "^To:[ \t]+\\(.*\\)\n" nil t)
	(if (equal email (buffer-substring (match-beginning 1) (match-end 1)))
	    t
	  nil)
      nil)))

(defvar tc-groups-functions
    '( ( "" . tc-simple-attributor ) )
  "An alist of of functions to make an attribution in various groups.
The key of each assoc pair is a group prefix or regex for the groups
where this should be used.  Earlier group matches override later ones.
A key that starts with a letter is assumed to be a group prefix,
anything else is a regex.  To have a regexp start with a letter, start
it with the trivial range, e.g [c]omp.

Each function takes a date (day, date year) and a name (\"you\", name
or email address) and should return the attribution as a string
without newlines.  It will be reformatted.

Some example attribution functions (attributors) are:
`tc-simple-attributor', `tc-random-attributor',
`tc-rhod-group-attributor', `tc-java-group-attributor', and
`tc-local-group-attributor'.")

;; This function due to Kai Grojohann
(defun tc-simple-attributor (date name)
  "A simple attribution function suitable as default for `tc-groups-functions'.
Uses DATE and NAME arguments."
  (concat "On " date ", " name " wrote:"))

;;; ************************************************************
;;; These are more examples of how to make personalized attributions.
;;; If you use tc-fancy-attributions, you should change these to suit
;;; your style.
;;; ************************************************************

(defun tc-random-attributor (date name)
  "Generate a random attribution suitable for any context.
Uses DATE and NAME arguments."
  (let ((style (random 7)))
    (cond ((= style 0)
	   (concat "On " date ", " name " stated:"))
	  ((= style 1)
	   (concat "On " date ", " name " spake thusly:"))
	  ((= style 2)
	   (concat "On " date ", " name " uttered the following:"))
	  ((= style 3)
	   (concat "On " date ", " name " outgrape:"))
	  ((= style 4)
	   (concat "On " date ", " name " said:"))
	  ((= style 5)
	   (concat "On " date ", " name " verbalised:"))
	  ((= style 6)
	   (concat "On " date ", " name " told this:"))
	  (t
	   (concat "On " date ", " name " wrote:")))))

(defalias 'tc-generic-attribution 'tc-random-attributor)

(defun tc-rhod-group-attributor (date name)
  (let ((style (random 3)))
    (cond ((= style 0)
	   (concat "On " date ", " name
		   " thusly discussed the words of the Internet Oracle:"))
	  ((= style 1)
	   (concat "Paul Kelly can witness that " name " on " date " wrote:"))
	  ((= style 2)
	   (concat "On " date ", " name
		   " wrote, without the least grovelling:")))))

(defun tc-java-group-attributor (date name)
  (concat "On " date ", " name " used System.out.println with:"))

(defun tc-local-group-attributor (date name)
  (concat name " wrote this:"))

(defun tc-fancy-attribution ()
  "Make a personalized attribution.
The Newsgroups: field is examined to find appropriate sayings, and the real
name is used when available.  If you use this, you probably want to change
`tc-groups-functions' to reflect your favorite newsgroups."
  (let ((date (cdr-safe (assoc "date" tc-strings-list)))
	(email (cdr-safe (assoc "email-addr" tc-strings-list)))
	(name (cdr-safe (assoc "real-name" tc-strings-list)))
	(groups (cdr-safe (assoc "newsgroups" tc-strings-list))))
    (let ((date-part (if date date "an unknown date"))
	  (name-part (if nil ;(tc-reply-to-citee-p email)
			 "you"
		       (if name
			   name
			 (if email
			     email
			   "somebody@somewhere")))))
      (concat
       (if groups ;; This is sent to a newsgroup, not a person
	   (tc-group-attribution groups date-part name-part)
	 (let ((default-function (tc-find-with-predicate
				  '(lambda (group) (null (car group)))
				  tc-groups-functions)))
	   (if default-function
	       (apply (cdr default-function) date-part name-part '())
	     (tc-generic-attribution date-part name-part)))) "\n\n"))))

;; General function to find an element satisfying pred in list
(defun tc-find-with-predicate (pred list)
  (let ((found nil))
    (while (and list (not found))
      (if (apply pred (car list) ())
	  (setq found (car list))
	(setq list (cdr list))))
    found))

(defun tc-group-attribution (groups date name)
  (let ((group-function
	 (tc-find-with-predicate
	  '(lambda (group)
	     (let ((group-name (car group)))
	       (if (or (not group-name) (= 0 (length group-name)))
		   t
		 (tc-find-with-predicate
		  (if (= (char-syntax (string-to-char group-name)) ?w)
		      '(lambda (cited-group)
			 (if (>= tc-debug-level 1)
			     (message (concat "Checking " cited-group
					      " vs " group-name)))
			 (eq t (compare-strings
			       group-name 0 (length group-name)
			       cited-group 0 (length group-name))))
		    '(lambda (cited-group)
		       (if (>= tc-debug-level 1)
			   (message (concat "Regexp checking " cited-group
					    " vs " group-name)))
		       (string-match group-name cited-group)))
		     groups))))
	       tc-groups-functions)))
    (message name)
    (if group-function
	(apply (cdr group-function) date name ())
      (tc-generic-attribution date name))))

;; Acknowledgements
;; Patches and bug reports have been sent by the following people.
;; My thanks to all of them for helping me improve trivial-cite
;; Klaus Berndl 
;; Colin Walters 
;; Christoph Rohland 
;; Matthias Wiehl 
;; Kai Grojohann 
;; Knut Anders Hatlen 
;; Tommi Vainikainen 
;; Colin Rafferty 
;; Juergen Kreileder 
;; Daniel Pittman 
;; Vasily Korytov 
;; Benjamin Lewis 

;; My apologies to any I may have forgotten

;;; Version history:
;;; 0.0:  Trivial version
;;; 0.2:  Added documentation, changed name from simple-quote to trivial-cite.
;;; 0.3:  Streamlined header parsing, updated documentation.  Now leaves
;;;         (point) at start as mail-citation-hook wants it.
;;; 0.4:  Parsing is now RFC822 compliant.  Removes empty lines at end of
;;;         citation.  Can remove signatures.
;;; 0.5:  Can now fill paragraphs when the lines are too long, with one undo
;;;         per filling.  Works like a charm:)
;;; 0.6:  Debugged filling, added overlays to mark undoable fillings.
;;;         Tries to find ^--$ sig marker if the correct ^-- $ fails.
;;;         Is not fooled by bad cites that have inserted extra spaces before
;;;         old cites.
;;; 0.7:  New version of find-cite-len, which should be faster and
;;;         can handle cite-marks not ending in a space.  Also fills single-
;;;         line quotes, if the quote-marks are simple.  Added user-setting
;;;         for mouse-sensitive overlays.  Fixed signature removal so that
;;;         an immediate undo gives the quoted signature.  Added guessing
;;;         at unusual cite-marks.  Added distribution setup handling and
;;;         and maintainer variable.  Made group-sensitive attributions
;;;         work better.  Reorganized a lot.  Improved string-char-index.
;;; 0.7.1:  Uses a new marker instead of push-mark now.
;;; 0.8:  Now possibility of limiting the number of lines cited (good for
;;;         citing extremely long mails).
;;; 0.8.1: Bug fix of prefix parsing.
;;; 0.9:  New user-function tc-cite-region that cites like tc, but without
;;;         parsing headers or removing signature.
;;; 0.10: Customization added.  My, this is neat.
;;; 0.10.1: Cut >80 char lines split.
;;; 0.10.2: Renamed tc-unformat-area[-mouse] to tc-unfill-paragraph[-mouse].
;;; 0.10.3: Bug fix from kahatlen@online.no
;;; 0.10.4: Added } as quote char.
;;; 0.11: Added tc-fill-cited-region-uniformly
;;; 0.11.1: Fixed bug with space-only header fields.
;;; 0.11.2-4: Minor contributed bugfixes
;;; 0.11.5: Trailing whitespace remove by suggestion from Brett Randall,
;;;         XEmacs compatability with help from Sebastian Kaps and others
;;; 0.11.6: Cite-mark fixup thanks to Matthias Wiehl
;;;         Changed to using C-c C-p for undo formatting.
;;;         Added fix to avoid the signature being messed up by mails with
;;;         no final newline.
;;; 0.12:   Numerous patches, including (mark t).
;;;         Also rework of fancy-attributes, renaming of subfunctions to
;;;         `attributor', fix of too long cite lines breaking fill.
;;; 0.12.1: Small fixes in tc-fancy-attributor after trying it out:)
;;; 0.12.2: Fixes of two compilation problems, thanks to Steve Evans
;;; 0.12.3: Updated license text
;;; 0.12.4: Typo fixed.  Made date parsing use date-to-time and
;;;         format-time-string, allowing easier customization.
;;; 0.13:   Stuff from Vasily Korytov :  Before
;;;         and after hooks, no spurious extra trailing spaces,
;;;         tc-fill-long-lines morphed into tc-fill-column.
;;; 0.13.1: Use guessed marks in normalizing citation marks.
;;; 0.13.2: Use a local let instead of setting fill-column.
;;; 0.13.3: Moving a parenthesis fixed a missing space problem.
;;; 0.13.4: Peter S. Galbraith 
;;;          Checkdoc edits.
;;;          New tc-make-attribution defcustom.
;;;          Reorder functions for cleaner byte-compilation.
;;;          Added tc-attribution-name-and-email-wrote.
;;;          Changed end bracket style with Lars' okay.
;;;          Renamed functions note prefixed with tc-.
;; end of tc.el

(provide 'tc)

;;; tc.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/ascii.el0000664000000000000000000007353412230377266020672 0ustar  ;;; ascii.el --- ASCII code display.

;; Copyright (C) 1999, 2000, 2001, 2006, 2007, 2008, 2009, 2010, 2011
;; Vinicius Jose Latorre

;; Author:	Vinicius Jose Latorre 
;; Maintainer:	Vinicius Jose Latorre 
;; Time-stamp:	<2011/01/12 00:58:17 vinicius>
;; Keywords:	data, ascii
;; Version:	3.1
;; X-URL:	http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre

;; This file is *NOT* (yet?) part of GNU Emacs.

;; 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 2, 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
;; GNU Emacs; see the file COPYING.  If not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

;;; Commentary:

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Introduction
;; ------------
;;
;; This package provides a way to display ASCII code on a window, that is,
;; display in another window an ASCII table highlighting the current character
;; code.
;;
;; Well, maybe the name "ascii" is not a good name for this package, as this
;; package also displays non-ASCII code, that is, character code which is
;; greater than 255.  It also displays characters codified in HTML (Á),
;; quoted (=20), escaped (\xFF) and Emacs Lisp character (?\^A).
;;
;; To use ascii, insert in your ~/.emacs:
;;
;;    (require 'ascii)
;;
;; Or:
;;
;;    (autoload 'ascii-on        "ascii" "Turn on ASCII code display."   t)
;;    (autoload 'ascii-off       "ascii" "Turn off ASCII code display."  t)
;;    (autoload 'ascii-display   "ascii" "Toggle ASCII code display."    t)
;;    (autoload 'ascii-customize "ascii" "Customize ASCII code display." t)
;;
;; For good performance, be sure to byte-compile ascii.el, e.g.
;;
;;    M-x byte-compile-file 
;;
;; This will generate ascii.elc, which will be loaded instead of ascii.el.
;;
;; It runs on GNU Emacs 20.4.1, 21, 22 and 23.
;;
;;
;; Using ascii
;; -----------
;;
;; To activate ascii, type:
;;
;;    M-x ascii-on RET
;;
;; Or:
;;
;;    C-u 1 M-x ascii-display RET
;;
;; To deactivate ascii, type:
;;
;;    M-x ascii-off RET
;;
;; Or:
;;
;;    C-u 0 M-x ascii-display RET
;;
;; To toggle ascii, type:
;;
;;    M-x ascii-display RET
;;
;; To customize ascii, type:
;;
;;    M-x ascii-customize RET
;;
;; You can also bind `ascii-display', `ascii-on', `ascii-off' and
;; `ascii-customize' to some key, like:
;;
;;    (global-set-key "\C-c\C-a" 'ascii-on)
;;    (global-set-key "\C-c\C-e" 'ascii-off)
;;    (global-set-key "\C-c\C-t" 'ascii-display)
;;    (global-set-key "\C-c\C-c" 'ascii-customize)
;;
;; If you're using `mule' package, a good usage example is to activate `ascii'
;; on emacs/etc/HELLO file.
;;
;;
;; Hooks
;; -----
;;
;; ascii has the following hook variable:
;;
;; `ascii-hook'
;;    It is evaluated once when ascii is turned on.
;;
;;
;; Options
;; -------
;;
;; Below it's shown a brief description of ascii options, please, see the
;; options declaration in the code for a long documentation.
;;
;; `ascii-code'				Specify list of character code to
;;					display.
;;
;; `ascii-show-nonascii'		Non-nil means converts to unibyte and
;;					display the ascii code.
;;
;; `ascii-show-nonascii-message'	Non-nil means show a message when
;;					character is above 255.
;;
;; `ascii-window-size'			Specify initial ASCII window size.
;;
;; `ascii-display-code'			Specify list of character range to be
;;					displayed.
;;
;; `ascii-keep-window'			Non-nil means to keep ASCII window
;;					active.
;;
;; `ascii-table-separator'		Specify string used to separate ASCII
;;					table columns.
;;
;; `ascii-ascii-face'			Specify symbol face used to highlight
;;					ascii code.
;;
;; `ascii-non-ascii-face'		Specify symbol face used to highlight
;;					non-ascii code.
;;
;; To set the above options you may:
;;
;; a) insert the code in your ~/.emacs, like:
;;
;;	 (setq ascii-window-size 6)
;;
;;    This way always keep your default settings when you enter a new Emacs
;;    session.
;;
;; b) or use `set-variable' in your Emacs session, like:
;;
;;	 M-x set-variable RET ascii-window-size RET 6 RET
;;
;;    This way keep your settings only during the current Emacs session.
;;
;; c) or use customization, for example:
;;	 click on menu-bar *Help* option,
;;	 then click on *Customize*,
;;	 then click on *Browse Customization Groups*,
;;	 expand *Data* group,
;;	 expand *Ascii* group
;;	 and then customize ascii options.
;;    Through this way, you may choose if the settings are kept or not when
;;    you leave out the current Emacs session.
;;
;; d) or see the option value:
;;
;;	 C-h v ascii-window-size RET
;;
;;    and click the *customize* hypertext button.
;;    Through this way, you may choose if the settings are kept or not when
;;    you leave out the current Emacs session.
;;
;; e) or invoke:
;;
;;	 M-x ascii-customize RET
;;
;;    and then customize ascii options.
;;    Through this way, you may choose if the settings are kept or not when
;;    you leave out the current Emacs session.
;;
;;
;; Acknowledgments
;; ---------------
;;
;; Thanks to Steven W. Orr  for patch to Emacs 23.
;;
;; Thanks to Roman Belenov  for suggestion on dynamic ascii
;; table evaluation (depending on character encoding).
;;
;; Thanks to Alex Schroeder  for suggestion on customization.
;;
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; code:


;; XEmacs needs overlay emulation package.
(eval-and-compile
  (and (let (case-fold-search)
	 (string-match "XEmacs\\|Lucid\\|Epoch" emacs-version))
       (not (require 'overlay))
       (error "`ascii' requires `overlay' package.")))


;; GNU Emacs 20, 21 and 22 compatibility
(or (fboundp 'characterp)
    (defalias 'characterp 'char-valid-p))

 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User Variables:


;;; Interface to the command system


(defgroup ascii nil
  "ASCII code display"
  :link '(emacs-library-link :tag "Source Lisp File" "ascii.el")
  :prefix "ascii-"
  :group 'data)


(defcustom ascii-code '(quoted html backslash elisp)
  "*Specify list of character code to display.

If list is nil, display only ASCII code.

If list is non-nil, valid element values are:

   quoted	display quoted and ASCII code.
		Quoted code is specified by `=HH' where H is a hexadecimal
		character or by `=' followed by newline.  This character coding
		is used on MIME.  For example:
		=FF  =1f  =20  =

   html		display HTML and ASCII code.
		HTML code is specified by `&CODE;', for example:
		á  Á  À

   backslash	display backslash and ASCII code.
		Backslash code is specified by `\\CODE' like in C, for example:
		\\177  \\xFF  \\x1f  \\t  \\Z  \\\\

   elisp	display Emacs Lisp and ASCII code.
		Emacs Lisp code is specified by `?CODE', see how Emacs Lisp
		specify a character.  For example:
		??  ?a  ?A  ?\\^A  ?\\C-A
		?\\177  ?\\xFF  ?\\x1f  ?\\t  ?\\Z  ?\\\\

Any other value is ignored."
  :type '(repeat :tag "ASCII Code List"
		 (choice :menu-tag "ASCII Code"
			 :tag "ASCII Code"
			 (const :tag "Quoted" quoted)
			 (const :tag "HTML" html)
			 (const :tag "Backslash" backslash)
			 (const :tag "Elisp" elisp)))
  :group 'ascii)


(defcustom ascii-show-nonascii t
  "*Non-nil means converts to unibyte and display the ascii code."
  :type 'boolean
  :group 'ascii)


(defcustom ascii-show-nonascii-message t
  "*Non-nil means show a message when character is above 255."
  :type 'boolean
  :group 'ascii)


(defcustom ascii-window-size 6
  "*Specify initial ASCII window size."
  :type 'integer
  :group 'ascii)


(defcustom ascii-display-code '((?\000 . ?\377))
  "*Specify list of character range to be displayed.

Each element has the following form:

   (LOWER . UPPER)

LOWER and UPPER are the minimum and maximum character code, respectively.
A character is displayed if:
   LOWER <= character <= UPPER
   and 0 <= LOWER <= 255
   and 0 <= UPPER <= 255"
  :type '(repeat :tag "Range List"
		 (cons :tag "Range"
		       (integer :tag "From")
		       (integer :tag "To")))
  :group 'ascii)


(defcustom ascii-keep-window t
  "*Non-nil means to keep ASCII window active."
  :type 'boolean
  :group 'ascii)


(defcustom ascii-table-separator "|"
  "*Specify string used to separate ASCII table columns."
  :type 'string
  :group 'ascii)


(defcustom ascii-ascii-face 'ascii-ascii-face
  "*Specify symbol face used to highlight ascii code."
  :type 'face
  :group 'ascii)


;; secondary-selection face
(defface ascii-ascii-face
  '((((type tty) (class color))
     (:background "cyan" :foreground "black"))
    (((class color) (background light))
     (:background "paleturquoise"))
    (((class color) (background dark))
     (:background "SkyBlue4"))
    (t (:inverse-video t)))
  "Face used to highlight ascii code.")


(defcustom ascii-non-ascii-face 'ascii-non-ascii-face
  "*Specify symbol face used to highlight non-ascii code."
  :type 'face
  :group 'ascii)


;; highlight face
(defface ascii-non-ascii-face
  '((((type tty) (class color))
     (:background "green"))
    (((class color) (background light))
     (:background "darkseagreen2"))
    (((class color) (background dark))
     (:background "darkolivegreen"))
    (t (:inverse-video t)))
  "Face used to highlight non-ascii code.")

 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization


;;;###autoload
(defun ascii-customize ()
  "Customize ASCII options."
  (interactive)
  (customize-group 'ascii))

 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User commands


(defconst ascii-buffer-name " *ASCII*")


(defvar ascii-overlay         nil)
(defvar ascii-reference-count 0)


(defvar ascii-display nil)
(make-variable-buffer-local 'ascii-display)


;;;###autoload
(defun ascii-display (&optional arg)
  "Toggle ASCII code display.

If ARG is null, toggle ASCII code display.
If ARG is a number and is greater than zero, turn on display; otherwise, turn
off display.
If ARG is anything else, turn on display."
  (interactive "P")
  (if (if arg
	  (> (prefix-numeric-value arg) 0)
	(not ascii-display))
      (ascii-on)
    (ascii-off)))


;;;###autoload
(defun ascii-on ()
  "Turn on ASCII code display."
  (interactive)
  (unless ascii-display
    (setq ascii-display         t
	  ascii-reference-count (1+ ascii-reference-count))
    ;; local hooks
    (add-hook 'post-command-hook 'ascii-post-command nil t)
    (add-hook 'kill-buffer-hook 'ascii-off nil t)
    ;; own hook
    (run-hooks 'ascii-hook)
    (ascii-post-command)))


;;;###autoload
(defun ascii-off ()
  "Turn off ASCII code display."
  (interactive)
  (when ascii-display
    (setq ascii-display         nil
	  ascii-reference-count (1- ascii-reference-count))
    (remove-hook 'post-command-hook 'ascii-post-command t)
    (remove-hook 'kill-buffer-hook 'ascii-off t)
    (if (> ascii-reference-count 0)
	;; at least one buffer with ascii activated
	(or ascii-keep-window
	    (ascii-hide-table))
      ;; *no* buffer with ascii activated
      (and ascii-overlay
	   (delete-overlay ascii-overlay))
      (let ((buffer (get-buffer ascii-buffer-name)))
	(and buffer
	     (save-excursion
	       (delete-windows-on buffer)
	       (kill-buffer buffer)))))))

 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal variables


(defconst ascii-table
  (concat
   ;; (0 <= x <= 127)
   " OCT DEC HX               |-  OCT DEC HX    |-  OCT DEC HX    \
|-  OCT DEC HX\n"
   (let ((str "")
	 (c   -1)
	 (cod [
	       "C-@ NUL ^@   "		; 0
	       "C-a SOH ^A   "		; 1
	       "C-b STX ^B   "		; 2
	       "C-c ETX ^C   "		; 3
	       "C-d EOT ^D   "		; 4
	       "C-e ENQ ^E   "		; 5
	       "C-f ACK ^F   "		; 6
	       "C-g BEL ^G \\a"		; 7
	       "C-h BS  ^H \\b"		; 8
	       "TAB HT  ^I \\t"		; 9
	       "C-j LF  ^J \\n"		; 10
	       "C-k VT  ^K \\v"		; 11
	       "C-l FF  ^L \\f"		; 12
	       "RET CR  ^M \\r"		; 13
	       "C-n SO  ^N   "		; 14
	       "C-o SI  ^O   "		; 15
	       "C-p DLE ^P   "		; 16
	       "C-q DC1 ^Q   "		; 17
	       "C-r DC2 ^R   "		; 18
	       "C-s DC3 ^S   "		; 19
	       "C-t DC4 ^T   "		; 20
	       "C-u NAK ^U   "		; 21
	       "C-v SYN ^V   "		; 22
	       "C-w ETB ^W   "		; 23
	       "C-x CAN ^X   "		; 24
	       "C-y EM  ^Y   "		; 25
	       "C-z SUB ^Z   "		; 26
	       "ESC ESC ^[ \\e"		; 27
	       "C-\\ FS  ^\\   "	; 28
	       "C-] GS  ^]   "		; 29
	       "C-^ RS  ^^   "		; 30
	       "C-_ US  ^_   "		; 31
	       ])
	 c32 c64 c96)
     (while (< c 31)
       (setq c   (1+ c)
	     c32 (+ c 32)
	     c64 (+ c 64)
	     c96 (+ c 96)
	     str (concat
		  str
		  (format "\\%03o %03d %02x  %s|| \\%03o %03d %02x %s|| \
\\%03o %03d %02x  %c || \\%03o %03d %02x %s\n"
			  c   c   c (aref cod c)
			  c32 c32 c32
			  (if (= c32 ?\x20) "SPC"    (format " %c "c32))
			  c64 c64 c64 c64
			  c96 c96 c96
			  (if (= c96 ?\x7F) "DEL ^?" (format " %c" c96))))))
     str)

   ;; (128 <= x <= 255)
   "\n OCT DEC HX               |-  OCT DEC HX    |-  OCT DEC HX    \
|-  OCT DEC HX\n"
   (let ((str "")
	 (c   127)
	 c32 c64 c96)
     (while (< c 159)
       (setq c   (1+ c)
	     c32 (+ c 32)
	     c64 (+ c 64)
	     c96 (+ c 96)
	     str (concat
		  str
		  (format "\\%03o %03d %02x  \\%03o         || \
\\%03o %03d %02x  %c || \\%03o %03d %02x  %c || \\%03o %03d %02x  %c\n"
			  c   c   c   c
			  c32 c32 c32 c32
			  c64 c64 c64 c64
			  c96 c96 c96 c96))))
     str))
  "ASCII table.")


(defconst ascii-position
  (vector
   ;; 0             1             2             3
   [2  0  23 0]  [3  0  23 0]  [4  0  23 0]  [5  0  23 0]
   ;; 4             5             6             7
   [6  0  23 0]  [7  0  23 0]  [8  0  23 0]  [9  0  26 0]
   ;; 8             9             10            11
   [10 0  26 0]  [11 0  26 0]  [12 0  26 0]  [13 0  26 0]
   ;; 12            13            14            15
   [14 0  26 0]  [15 0  26 0]  [16 0  23 0]  [17 0  23 0]
   ;; 16            17            18            19
   [18 0  23 0]  [19 0  23 0]  [20 0  23 0]  [21 0  23 0]
   ;; 20            21            22            23
   [22 0  23 0]  [23 0  23 0]  [24 0  23 0]  [25 0  23 0]
   ;; 24            25            26            27
   [26 0  23 0]  [27 0  23 0]  [28 0  23 0]  [29 0  26 0]
   ;; 28            29            30            31
   [30 0  23 0]  [31 0  23 0]  [32 0  23 0]  [33 0  23 0]
   ;; 32            33            34            35
   [2  28 43 1]  [3  28 42 1]  [4  28 42 1]  [5  28 42 1]
   ;; 36            37            38            39
   [6  28 42 1]  [7  28 42 1]  [8  28 42 1]  [9  28 42 1]
   ;; 40            41            42            43
   [10 28 42 1]  [11 28 42 1]  [12 28 42 1]  [13 28 42 1]
   ;; 44            45            46            47
   [14 28 42 1]  [15 28 42 1]  [16 28 42 1]  [17 28 42 1]
   ;; 48            49            50            51
   [18 28 42 1]  [19 28 42 1]  [20 28 42 1]  [21 28 42 1]
   ;; 52            53            54            55
   [22 28 42 1]  [23 28 42 1]  [24 28 42 1]  [25 28 42 1]
   ;; 56            57            58            59
   [26 28 42 1]  [27 28 42 1]  [28 28 42 1]  [29 28 42 1]
   ;; 60            61            62            63
   [30 28 42 1]  [31 28 42 1]  [32 28 42 1]  [33 28 42 1]
   ;; 64            65            66            67
   [2  45 59 2]  [3  45 59 2]  [4  45 59 2]  [5  45 59 2]
   ;; 68            69            70            71
   [6  45 59 2]  [7  45 59 2]  [8  45 59 2]  [9  45 59 2]
   ;; 72            73            74            75
   [10 45 59 2]  [11 45 59 2]  [12 45 59 2]  [13 45 59 2]
   ;; 76            77            78            79
   [14 45 59 2]  [15 45 59 2]  [16 45 59 2]  [17 45 59 2]
   ;; 80            81            82            83
   [18 45 59 2]  [19 45 59 2]  [20 45 59 2]  [21 45 59 2]
   ;; 84            85            86            87
   [22 45 59 2]  [23 45 59 2]  [24 45 59 2]  [25 45 59 2]
   ;; 88            89            90            91
   [26 45 59 2]  [27 45 59 2]  [28 45 59 2]  [29 45 59 2]
   ;; 92            93            94            95
   [30 45 59 2]  [31 45 59 2]  [32 45 59 2]  [33 45 59 2]
   ;; 96            97            98            99
   [2  62 76 3]  [3  62 76 3]  [4  62 76 3]  [5  62 76 3]
   ;; 100           101           102           103
   [6  62 76 3]  [7  62 76 3]  [8  62 76 3]  [9  62 76 3]
   ;; 104           105           106           107
   [10 62 76 3]  [11 62 76 3]  [12 62 76 3]  [13 62 76 3]
   ;; 108           109           110           111
   [14 62 76 3]  [15 62 76 3]  [16 62 76 3]  [17 62 76 3]
   ;; 112           113           114           115
   [18 62 76 3]  [19 62 76 3]  [20 62 76 3]  [21 62 76 3]
   ;; 116           117           118           119
   [22 62 76 3]  [23 62 76 3]  [24 62 76 3]  [25 62 76 3]
   ;; 120           121           122           123
   [26 62 76 3]  [27 62 76 3]  [28 62 76 3]  [29 62 76 3]
   ;; 124           125           126           127
   [30 62 76 3]  [31 62 76 3]  [32 62 76 3]  [33 62 80 3]
   ;; 128           129           130           131
   [36 0  17 0]  [37 0  17 0]  [38 0  17 0]  [39 0  17 0]
   ;; 132           133           134           135
   [40 0  17 0]  [41 0  17 0]  [42 0  17 0]  [43 0  17 0]
   ;; 136           137           138           139
   [44 0  17 0]  [45 0  17 0]  [46 0  17 0]  [47 0  17 0]
   ;; 140           141           142           143
   [48 0  17 0]  [49 0  17 0]  [50 0  17 0]  [51 0  17 0]
   ;; 144           145           146           147
   [52 0  17 0]  [53 0  17 0]  [54 0  14 0]  [55 0  17 0]
   ;; 148           149           150           151
   [56 0  17 0]  [57 0  17 0]  [58 0  17 0]  [59 0  17 0]
   ;; 152           153           154           155
   [60 0  17 0]  [61 0  17 0]  [62 0  17 0]  [63 0  17 0]
   ;; 156           157           158           159
   [64 0  17 0]  [65 0  17 0]  [66 0  17 0]  [67 0  17 0]
   ;; 160           161           162           163
   [36 28 42 1]  [37 28 42 1]  [38 28 42 1]  [39 28 42 1]
   ;; 164           165           166           167
   [40 28 42 1]  [41 28 42 1]  [42 28 42 1]  [43 28 42 1]
   ;; 168           169           170           171
   [44 28 42 1]  [45 28 42 1]  [46 28 42 1]  [47 28 42 1]
   ;; 172           173           174           175
   [48 28 42 1]  [49 28 42 1]  [50 28 42 1]  [51 28 42 1]
   ;; 176           177           178           179
   [52 28 42 1]  [53 28 42 1]  [54 28 42 1]  [55 28 42 1]
   ;; 180           181           182           183
   [56 28 42 1]  [57 28 42 1]  [58 28 42 1]  [59 28 42 1]
   ;; 184           185           186           187
   [60 28 42 1]  [61 28 42 1]  [62 28 42 1]  [63 28 42 1]
   ;; 188           189           190           191
   [64 28 42 1]  [65 28 42 1]  [66 28 42 1]  [67 28 42 1]
   ;; 192           193           194           195
   [36 45 59 2]  [37 45 59 2]  [38 45 59 2]  [39 45 59 2]
   ;; 196           197           198           199
   [40 45 59 2]  [41 45 59 2]  [42 45 59 2]  [43 45 59 2]
   ;; 200           201           202           203
   [44 45 59 2]  [45 45 59 2]  [46 45 59 2]  [47 45 59 2]
   ;; 204           205           206           207
   [48 45 59 2]  [49 45 59 2]  [50 45 59 2]  [51 45 59 2]
   ;; 208           209           210           211
   [52 45 59 2]  [53 45 59 2]  [54 45 59 2]  [55 45 59 2]
   ;; 212           213           214           215
   [56 45 59 2]  [57 45 59 2]  [58 45 59 2]  [59 45 59 2]
   ;; 216           217           218           219
   [60 45 59 2]  [61 45 59 2]  [62 45 59 2]  [63 45 59 2]
   ;; 220           221           222           223
   [64 45 59 2]  [65 45 59 2]  [66 45 59 2]  [67 45 59 2]
   ;; 224           225           226           227
   [36 62 76 3]  [37 62 76 3]  [38 62 76 3]  [39 62 76 3]
   ;; 228           229           230           231
   [40 62 76 3]  [41 62 76 3]  [42 62 76 3]  [43 62 76 3]
   ;; 232           233           234           235
   [44 62 76 3]  [45 62 76 3]  [46 62 76 3]  [47 62 76 3]
   ;; 236           237           238           239
   [48 62 76 3]  [49 62 76 3]  [50 62 76 3]  [51 62 76 3]
   ;; 240           241           242           243
   [52 62 76 3]  [53 62 76 3]  [54 62 76 3]  [55 62 76 3]
   ;; 244           245           246           247
   [56 62 76 3]  [57 62 76 3]  [58 62 76 3]  [59 62 76 3]
   ;; 248           249           250           251
   [60 62 76 3]  [61 62 76 3]  [62 62 76 3]  [63 62 76 3]
   ;; 252           253           254           255
   [64 62 76 3]  [65 62 76 3]  [66 62 76 3]  [67 62 76 3]
   )
  "Vector with position of each ASCII code in ASCII buffer.

Each element has the following form:

   [LINE COL-BEG COL-END COL-INDEX]

LINE is the line number in ASCII buffer.
COL-BEG is the ASCII beginning column.
COL-END is the ASCII end column.
COL-INDEX is the ASCII table column index.")

 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions


(defun ascii-post-command ()
  (let* ((char (following-char))
	 (code (if ascii-show-nonascii
		   (string-to-char (string-make-unibyte (char-to-string char)))
		 char))
	 mess)
    (cond ((and (boundp 'ascii-display)
		ascii-display
		(< code 256)
		(ascii-display-code code))
	   (setq mess (ascii-show-table code (< char 256))))
	  ((and (not ascii-keep-window)
		(not (string= (buffer-name) ascii-buffer-name)))
	   (ascii-hide-table))
	  (ascii-overlay
	   (delete-overlay ascii-overlay))
	  )
    ;; display some warning
    (cond ((and (boundp 'ascii-display)
		ascii-display
		ascii-show-nonascii-message
		(cond
		 ((> char 255)
		  (message "Character code above 255 (\\0%o, %d, 0x%x)"
			   char char char))
		 ((< char 0)
		  (message "Character code below 0 (\\0%o, %d, 0x%x)"
			   char char char))
		 )))
	  (mess
	   (message "%s code" mess))
	  )))


(defun ascii-hide-table ()
  (let ((buffer (get-buffer ascii-buffer-name)))
    (and buffer
	 (delete-windows-on buffer))))


(defconst ascii-html-alist
  '(("copy"   . 169) ("reg"    . 174) ("trade"  . 174) ("Aacute" . 192)
    ("Agrave" . 193) ("Acirc"  . 194) ("Atilde" . 195) ("Auml"   . 196)
    ("Aring"  . 197) ("AElig"  . 198) ("Ccedil" . 199) ("Eacute" . 200)
    ("Egrave" . 201) ("Ecirc"  . 202) ("Euml"   . 203) ("Iacute" . 204)
    ("Igrave" . 205) ("Icirc"  . 206) ("Iuml"   . 207) ("ETH"    . 208)
    ("Ntilde" . 209) ("Oacute" . 210) ("Ograve" . 211) ("Ocirc"  . 212)
    ("Otilde" . 213) ("Ouml"   . 214) ("Oslash" . 216) ("Uacute" . 217)
    ("Ugrave" . 218) ("Ucirc"  . 219) ("Uuml"   . 220) ("Yacute" . 221)
    ("THORN"  . 222) ("szlig"  . 223) ("aacute" . 224) ("agrave" . 225)
    ("acirc"  . 226) ("atilde" . 227) ("auml"   . 228) ("aring"  . 229)
    ("aelig"  . 230) ("ccedil" . 231) ("eacute" . 232) ("egrave" . 233)
    ("ecirc"  . 234) ("euml"   . 235) ("iacute" . 236) ("igrave" . 237)
    ("icirc"  . 238) ("iuml"   . 239) ("eth"    . 240) ("ntilde" . 241)
    ("oacute" . 242) ("ograve" . 243) ("ocirc"  . 244) ("otilde" . 245)
    ("ouml"   . 246) ("oslash" . 248) ("uacute" . 249) ("ugrave" . 250)
    ("ucirc"  . 251) ("uuml"   . 252) ("yacute" . 253) ("thorn"  . 254)
    ("yuml"   . 255)))


;; á  Á  À
(defconst ascii-html-regexp
  (concat "&\\([aeiouy]acute\\|[aeiou]circ\\|[aeiou]grave\\|[aeiouy]uml\\|"
	   "aelig\\|aring\\|[ano]tilde\\|ccedil\\|copy\\|eth\\|oslash\\|"
	   "reg\\|szlig\\|thorn\\|trade\\|"
	   "#[0-9]+\\);"))


;; \177  \xFF  \t  \Z  \\
(defconst ascii-backslash-regexp
  "\\\\\\([0-7]+\\|x[0-9A-Fa-f]+\\|\n\\|.\\)")


;; ?A  ?\^A  ?\C-A  ?\177  ?\xFF  ?\t  ?\Z  ?\\
(defconst ascii-elisp-regexp
  (concat "?\\(\\\\\\(\\^\\|C-\\)[@A-Za-_]\\|"
	  ascii-backslash-regexp
	  "\\|.\\)"))


(defsubst ascii-string-matched (level)
  (buffer-substring-no-properties
   (match-beginning level) (match-end level)))


(defsubst ascii-string-to-char (str)
  (string-to-char (car (read-from-string (concat "\"" str "\"")))))


(defsubst ascii-char-matched (level)
  (ascii-string-to-char (ascii-string-matched level)))


(defsubst ascii-code (code var-sym)
  (save-match-data
    (cond
     ;; Quoted
     ((and (memq 'quoted ascii-code)
	   (cond ((looking-at "=\n")
		  (set var-sym "Quoted")
		  ?\n)
		 ((looking-at "=\\([0-9A-Fa-f][0-9A-Fa-f]\\)")
		  (set var-sym "Quoted")
		  (string-to-number (ascii-string-matched 1) 16)))))
     ;; HTML
     ((and (memq 'html ascii-code)
	   (let ((case-fold-search t))
	     (looking-at ascii-html-regexp)))
      (set var-sym "HTML")
      (let ((str (ascii-string-matched 1)))
	(cond ((eq (aref str 0) ?#)
	       (aset str 0 ?\ )
	       (let ((int (string-to-number str)))
		 (if (and (<= 0 int) (<= int 255))
		     int
		   (set var-sym nil)
		   code)))
	      ((cdr (assoc str ascii-html-alist)))
	      (t
	       (set var-sym nil)
	       code))))
     ;; backslash
     ((and (memq 'backslash ascii-code)
	   (looking-at ascii-backslash-regexp))
      (set var-sym "Backslash")
      (let* ((str  (ascii-string-matched 0))
	     (last (aref str (1- (length str)))))
	(if (memq last '(?^ ?C ?\n))
	    last
	  (ascii-string-to-char str))))
     ;; elisp
     ((and (memq 'elisp ascii-code)
	   (looking-at ascii-elisp-regexp))
      (set var-sym "Elisp")
      (ascii-char-matched 1))
     ;; ASCII
     (t
      (set var-sym nil)
      code))))


(defvar ascii-sep-len      0)
(defvar ascii-charset-base 0)


(defun ascii-show-table (code ascii-p)
  (let ((buffer (ascii-get-buffer code))
	mess)
    (and
     ;; adjust ascii window
     (cond ((get-buffer-window buffer)
	    t)
	   ((>= (window-height) (+ ascii-window-size ascii-window-size))
	    (set-window-buffer
	     (split-window nil (- (window-height) ascii-window-size))
	     buffer)
	    t)
	   (t
	    (ascii-off)
	    (message "Window height too small for ASCII window.")
	    (ding)
	    nil)
	   )
     ;; adjust overlay
     (let ((code       (ascii-code code 'mess))
	   (window     (get-buffer-window ascii-buffer-name))
	   (old-window (selected-window)))
       (save-excursion
	 (and window
	      (select-window window))
	 (set-buffer ascii-buffer-name)
	 (let ((pos (aref ascii-position code))
	       beg end)
	   (goto-char (point-min))
	   (forward-line (1- (aref pos 0)))
	   (if (and (> code 127) (/= ascii-charset-base 127))
	       (save-match-data
		 (re-search-forward
		  (format "\\\\%o %d %x  \\(\\\\..\\)?."
			  code code code)
		  nil t)
		 (setq beg (match-beginning 0)
		       end (match-end 0)))
	     (let ((here (point))
		   (bias (* (aref pos 3) ascii-sep-len)))
	       (setq end  (+ (aref pos 2) here bias)
		     beg  (+ (aref pos 1) here bias))))
	   (if ascii-overlay
	       (move-overlay ascii-overlay beg end)
	     (setq ascii-overlay (make-overlay beg end)))
	   (overlay-put ascii-overlay 'face (if ascii-p
						ascii-ascii-face
					      ascii-non-ascii-face))))
       (select-window old-window)))
    mess))


(defvar ascii-mark-display-code nil)
(defvar ascii-vector-code (make-vector 256 t))


(defun ascii-display-code (code)
  (or (eq ascii-mark-display-code ascii-display-code)
      (let ((lis  ascii-display-code)
	    (char 0)
	    end)
	(setq ascii-mark-display-code ascii-display-code)
	;; turn off all `ascii-vector-code'
	(while (<= char 255)
	  (aset ascii-vector-code char nil)
	  (setq char (1+ char)))
	;; turn on valid ranges
	(while lis
	  (setq char (car lis)
		lis  (cdr lis)
		end  (cdr char)
		char (car char))
	  (and (<= 0 end)  (<= end 255)
	       (<= 0 char) (<= char 255)
	       (while (<= char end)
		 (aset ascii-vector-code char t)
		 (setq char (1+ char)))))))
  (aref ascii-vector-code code))


(defun ascii-get-buffer (code)
  (let ((base (- (following-char) (- code 127))))
    (or (if (= ascii-charset-base base)
	    (get-buffer ascii-buffer-name)
	  (setq ascii-charset-base base)
	  (let ((buffer (get-buffer ascii-buffer-name)))
	    (when buffer
	      (delete-windows-on buffer)
	      (kill-buffer buffer)))
	  nil)
	(save-excursion
	  (save-match-data
	    (prog1
		;; create buffer
		(set-buffer (get-buffer-create ascii-buffer-name))
	      (set-buffer-multibyte t)
	      (setq buffer-read-only nil
		    ascii-sep-len    (1- (length ascii-table-separator)))
	      (erase-buffer)
	      ;; insert ascii table
	      (insert ascii-table)
	      (goto-char (point-min))
	      (or (= base 127)
		  (save-excursion
		    (let ((char 127))
		      ;; characters from 128 to 159
		      (while (< (setq char (1+ char)) 160)
			(when (search-forward
			       (format "\\%o %d %x  " char char char)
			       nil t)
			  (delete-char 4)
			  (setq base (1+ base))
			  (if (not (characterp base))
			      (insert "?   ")
			    (insert base)
			    (let ((cols (- (current-column)
					   (progn
					     (forward-char -1)
					     (current-column)))))
			      (when (< cols 4)
				(forward-char 1)
				(insert (cond ((= cols 3) " ")
					      ((= cols 2) "  ")
					      (t          "   ")
					      )))))))
		      ;; characters from 160 to 255
		      (setq char (1- char))
		      (while (< (setq char (1+ char)) 256)
			(goto-char (point-min))
			(when (search-forward
			       (format "\\%o %d %x  " char char char)
			       nil t)
			  (delete-char 1)
			  (setq base (1+ base))
			  (if (not (characterp base))
			      (insert "?")
			    (insert base)
			    (let ((cols (- (current-column)
					   (progn
					     (forward-char -1)
					     (current-column)))))
			      (when (> cols 1)
				(forward-char 1)
				(or (equal (following-char) ?\n)
				    (delete-char 1))))))))))
	      ;; adjust column table separator
	      (save-excursion
		(while (search-forward "||" nil t)
		  (replace-match ascii-table-separator t t)))
	      ;; adjust header separator
	      (let ((spaces (make-string (1+ ascii-sep-len) ?\ )))
		(save-excursion
		  (while (search-forward "|-" nil t)
		    (replace-match spaces t t))))
	      (set-buffer-modified-p nil)
	      (setq buffer-read-only t)))))))

 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(provide 'ascii)


;;; ascii.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/map-lines.el0000775000000000000000000001310112230377265021451 0ustar  ;;; map-lines.el --- Map a command over many lines

;; Copyright (C) 2002  Andreas Fuchs 
;; Copyright (C) 2010  Paul Hobbs 

;; Author: Andreas Fuchs 
;; Maintainer: Paul Hobbs 
;; Keywords: matching, files

;; This file 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 2, or (at your option)
;; any later version.

;; This file 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; ------------------------------ TYPICAL USE ------------------------------
;; This module allows you to map a command over a set of lines
;; matching a regex.  The trick: You can then go ahead and insert these
;; lines in one clean yank.
;;
;; Example text:
;; 
;;     Hello,
;;     Here are the requested documents:
;;     a.txt
;;     b.txt
;;     c.txt
;;     Also, I have included the following:
;;     license.txt
;;
;; Running M-x map-lines-copy-regex ".txt" will give you
;;     a.txt
;;     b.txt
;;     c.txt
;;     license.txt
;;
;; This is also useful for using Emacs with UNIX: just run M-! ls, and filter
;; out the files you want to operate on using map-lines-kill, or grab those you
;; want using map-lines-copy.  Then, paste into a scratch buffer and use
;; keyboard macros and/or rectangles to form the commands you want to run on
;; each file, and to execute each command.  Nifty!

;; ------------------------------ INSTALLATION ------------------------------
;; To use this module, put this file somewhere in your load-path and this into
;; your .emacs:
;; (load-library "map-lines")
;; 
;; Alternatively, you can autoload the functions one at a time, which will
;; reduce your Emacs start-up time and typical RAM usage (slightly):
;;     (autoload 'map-lines "map-lines"
;;       "For each matching line, kill, copy or run a custom command" t)
;;     (autoload 'map-lines-kill "map-lines" "Kill each line matching regex" t)
;;     (autoload 'map-lines-copy "map-lines" "Copy each line matching regex" t)
;;     (autoload 'copy-line      "map-lines" "Copy the current line" t)
;;
;; You can set (recommended) keyboard shortcuts using
;;     (global-set-key (kbd "C-c m l") 'map-lines)
;;     (global-set-key (kbd "C-c m k") 'map-lines-kill)
;;     (global-set-key (kbd "C-c m c") 'map-lines-copy)
;;     (global-set-key (kbd "C-x c")
;;
;; ... or your own key combinations as you see fit.

;; ------------------------------ VERSIONS ------------------------------
;; This is version 0.2 of map-lines.el.
;;
;; You can find the latest version of this module in the debian package
;; emacs-goodies-el.  If you want to see new features, feel free to add them and
;; email the maintainer of this package.
;; 
;;; History:
;;
;; Version 0.2
;;  - Changed map-lines to always put a newline between each line, and added
;;    kill-lines and copy-lines.  (Paul Hobbs)
;;
;; Version 0.1
;;  - First version (Andreas Fuchs)

;;; Code:

(defvar mapl-command-alist
  '((?k . mapl-kill-line)
    (?c . mapl-copy-line)
    (?o . mapl-other-command))
  "An alist of command-char->command-name mappings.")


(defun mapl-lookup-command (command-char)
  "Return the matching command for COMMAND-CHAR."
  (let ((command (cdr (assq command-char mapl-command-alist))))
    (if (eq command 'mapl-other-command)
	(read-command "Other command (takes no args and returns a string): ")
      command)))

;;;###autoload
(defun map-lines (command-c regex)
  "Map a COMMAND-C (kill, copying, or a custom command) over lines matching REGEX."
  (interactive "cCommand (Kill, Copy, Other) [kco]:
sRegular Expression: ")
  (save-excursion
    (let ((command (mapl-lookup-command command-c))
	  (live-buffer (current-buffer)))
      (with-temp-buffer
	(let ((temp-buffer (current-buffer)))
	  (with-current-buffer live-buffer
	    (goto-char (point-min))
	    (while (re-search-forward regex nil t)
	      (let ((the-line (funcall command)))
	        (with-current-buffer temp-buffer
		  (insert the-line)
		  (newline)))
	      (end-of-line)))
	  (kill-region (point-min) (point-max)))))))

(defun mapl-kill-line ()
  "Kill a line entirely and return it."
  (mapl-kill-universal (lambda () (kill-line))))


;;;###autoload
(defun copy-line ()
  "Copy a whole line to the kill ring."
  (interactive)
  (let ((original-point (point)))
    (copy-region-as-kill (progn (beginning-of-line)
				(point))
			 (progn (end-of-line)
				(point)))
    (goto-char original-point)))

(defun mapl-copy-line ()
  "Copy a line entirely and return it."
  (mapl-kill-universal (lambda () (copy-line))))

(defun mapl-kill-universal (kill-fun)
  "Execute KILL-FUN on an entire line."
  (beginning-of-line)
  (funcall kill-fun)
  (prog1 (car kill-ring)
    (setq kill-ring (cdr kill-ring))))

;;;###autoload
(defun map-lines-kill (regex)
  "Kill all lines matching REGEX.  Yanking will insert all killed lines."
  (interactive "sRegular Expression: ")
  (map-lines ?\k regex))

;;;###autoload
(defun map-lines-copy (regex)
  "Copy all lines matching REGEX to the kill ring.  Yanking will insert all such lines."
  (interactive "sRegular Expression: ")
  (map-lines ?\c regex))

(provide 'map-lines)
;;; map-lines.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/browse-huge-tar.el0000775000000000000000000002263312230377265022611 0ustar  ;;; browse-huge-tar.el --- Browse files in a tarball memory-efficiently.
;;;  $Id: browse-huge-tar.el,v 1.1 2003-11-17 19:44:28 psg Exp $
;;
;; (c) Gareth Owen 1999 (hey I just typed `space' 1999.  Ho ho.)

;; Bug reports, comments, improvements to  with
;; Subject: "Stop polluting Usenet with your crappy lisp code"
;; Or not, whatever.  Or just recommend your favourite records to me.

;; Latest (yeah, right) version: http://www.geocities.com/drgazowen/lisp/

;; This file is not part of GNU Emacs
;; This is released under the GNU Public License

;; 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 2, 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 GNU Emacs; if not, write to the Free Software Foundation, Inc.,
;; 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:
;; "It's that man Edwards! A dramatic start!"
;;              (Cliff Morgan, BBC TV, Barbarians vs.  New Zealand)

;;; Different Commentary:
;;
;; This uses tar (z)tvf to browse a gzipped tar file without opening the
;; whole thing, in a dired-stylee.  Knocked together in a fit of pique
;; after trying to read the xemacs source tarball in xemacs chewed through
;; all my swapspace one afternoon, and as an exercise in thesis avoidance.

;; The trade off is memory usage vs. speed.  This is very slow on large,
;; compressed tarballs, and each operation is slow individually, but
;; relatively low memory machines (like old 486s running one of the i386
;; unices) don't handle these well with jka-compress and tar-mode either.
;; XEmacs-20.4 was a 13MB gzipped tarball and the similarly packaged linux
;; kernel 2.0.36 was 7MB, so the memory savings can be pretty high too.

;; On small files the saving/price is pretty low, and
;; tar-mode/jka-compress have approximately 10^13 more features, so I'd
;; advise you to go that way.

;;; BUGS:
;;  i) Makes some reasonable but sometimes untrue assumptions: e.g.
;;  No spaces in filenames, unless browse-huge-tar-better-heuristics is non-nil
;;  files ending / in tarballs are directories. (The latter may even be true.)
;;  ii) Should perform sanity-checking for directories in
;;  `browse-huge-tar-copy-file-at-point' before the interactive prompt
;;  (using a wrapper and call-interactively?)
;;  iii) Things like default-directory that should probably get set, don't
;;  get set.
;;  iv)  Plenty of others that are probably just hiding.
;;  Bug reports to   Did I say that already?

;;  TODO: Option to make the decompressed file stick around to speed up
;;  repeated access at the cost of disk space.  Where would the clean-up
;;  go?  kill-buffer-hook?


;;; History:
;; 

;;; Code:
(defconst browse-huge-tar-filename-valid "^ \t"
  "String containing characters that mark the beginning of a filename.

Searched for using `skip-chars-backward'")

(defconst browse-huge-tar-filename-start-column 51
  "Column containing the start of the filename in listing produced by 'tar ztvf'.")


;; These magic bytes come from /usr/share/magic on my GNU/Linux box
;; Corroborated by Kai Grossjohann on comp.emacs
(defconst gzip-magic-bytes '(?\037 . ?\213)
  "Dotted pair of the characters that begin a gzip file.")

(defvar browse-huge-tar-program "tar"
  "Program used for reading the index of tar archives.
Defaults to \"tar\" but may be \"gtar\" on your system.  In all probability,
only those compatible with GNU tar will work")

(defvar browse-huge-tar-file-name nil
  "The filename of the tar file associated with this browse-huge-tar buffer.")
(make-variable-buffer-local 'browse-huge-tar-file-name)

(defvar browse-huge-tar-file-zipped-p nil
  "If non-nil, the tar file is gzipped.")
(make-variable-buffer-local 'browse-huge-tar-file-zipped-p)



;;; Define the interactive functions
;;;###autoload
(defun browse-huge-tar-file (filename)
  "Create a buffer containing a listing of FILENAME as a tar file."
  (interactive "fTar file:")
  ;; Set predictable values for the buffer-local variables
  (setq filename (expand-file-name filename))
  (let ((buf (generate-new-buffer (concat "tar:" filename)))
	(gzipped (browse-huge-tar-gzip-automagic filename)))
    (set-buffer buf)
    (browse-huge-tar-insert-listing filename buf gzipped)
    (switch-to-buffer buf)
    (browse-huge-tar-mode)
    (setq browse-huge-tar-file-name filename
	  browse-huge-tar-file-zipped-p gzipped)
    (setq buffer-read-only t)
    (set-buffer-modified-p nil)))

;; One for extracting the file through a pipe into a buffer
;;;###autoload
(defun browse-huge-tar-view-file-at-point ()
  "Extract the file at the point into a buffer for viewing."
  (interactive)
  (let ((filename (browse-huge-tar-get-filename)) buf)
    (setq buf (generate-new-buffer (concat "tar:" filename)))
    ;; Primitive directory detection
    (if (string-match "/$" filename)
	(progn ;; Clean up and abort
	  (kill-buffer buf)
	  (error (concat filename " appears to be a directory."))))
;;; (call-process PROGRAM &optional INFILE BUFFER DISPLAYP &rest ARGS)
    (call-process browse-huge-tar-program nil
		  buf nil (concat (if browse-huge-tar-file-zipped-p "z") "Oxf")
		  browse-huge-tar-file-name filename)
    (switch-to-buffer buf)
    (let ((buffer-file-name filename))
      (set-auto-mode))
    (setq buffer-read-only t)
    (set-buffer-modified-p nil)
    (goto-char (point-min))))

;;;###autoload
(defun browse-huge-tar-copy-file-at-point (outfile)
  "Extract the file at the point and copy to a local file OUTFILE.
This requires the value of `shell-file-name' to support redirection using \">\"."
  (interactive "FExtract file to: ")
  (setq outfile (expand-file-name outfile))
  ;; FIX Check for directory, provide reasonable suggestion.
  (let ((infile (browse-huge-tar-get-filename)))
    (if (string-match "/$" infile)
	(error (concat infile " appears to be a directory.")))
    (if (file-directory-p outfile)
	(setq outfile (concat outfile "/" infile)))
    (if (or (not (file-exists-p outfile))
	    (yes-or-no-p (concat outfile " exists.  Overwrite? ")))
	(progn
	  (message "Writing %s..." outfile)
	  (shell-command
	   (concat "tar" " "
		   (concat (if browse-huge-tar-file-zipped-p "z") "Oxf")
		   " " browse-huge-tar-file-name " " infile " > " outfile))))))


;; Create a keymap
(defvar browse-huge-tar-mode-map nil
  "Local keymap for browse-huge-tar-mode.")
(if browse-huge-tar-mode-map ()
  (setq browse-huge-tar-mode-map (make-keymap))
  (define-key browse-huge-tar-mode-map "\C-m" 'browse-huge-tar-view-file-at-point)
  (define-key browse-huge-tar-mode-map "C" 'browse-huge-tar-copy-file-at-point)
  )

(defvar browse-huge-tar-better-heuristics t
  "This variable controls which filename extracting heuristics to use.

If non-nil, filename fetching is based on browse-huge-tar-filename-start-column
Otherwise, it skips backwards looking for characters in
browse-huge-tar-filename-valid")


;; Define the utility functions
(defun browse-huge-tar-get-filename ()
  "In browse-huge-tar, return name of file mentioned on this line.
Value returned includes all path info associated with the file."
  ;; Compute bol & eol once,
  ;; (bol? Stol^H^H^H^HBorrowed code alert! from dired.el IIRC)
  (let ((eol (save-excursion (skip-chars-forward "^\n\r") (point))))
    (save-excursion
      (if browse-huge-tar-better-heuristics
	  (progn (move-to-column browse-huge-tar-filename-start-column)
		 (buffer-substring-no-properties (point) eol))
	(progn (goto-char eol) ;; Else
	       (skip-chars-backward browse-huge-tar-filename-valid)
	       (buffer-substring-no-properties (point) eol))))))

(defun browse-huge-tar-mode ()
  "Mode for browsing tar files without reading them into memory."
  (kill-all-local-variables)
  (setq major-mode 'browse-huge-tar-mode
	mode-name "Browse-Huge-Tar")
  (use-local-map browse-huge-tar-mode-map))

(defun browse-huge-tar-insert-listing (filename buf &optional gzipped)
  "Insert a listing of the contents of the tar-file FILENAME.

The contents are inserted into buffer BUF.
The optional argument GZIPPED should be non-nil if the tar file is compressed
with GNU gzip."
;;; (call-process PROGRAM &optional INFILE BUFFER DISPLAYP &rest ARGS)
  (let ((errorcode (call-process browse-huge-tar-program nil buf nil
				 (concat (if gzipped "z") "tvf") filename)))
    (if (or (not (integerp errorcode))
	    (not (equal errorcode 0)))
	;; Then clean up and abort.  Else, keep on keeping on
	(progn (kill-buffer buf)
	       (error "Tar process exited abnormally with exit code %s"
		      errorcode)))))

(defun browse-huge-tar-gzip-automagic (filename)
  "Read the first two bytes of file FILENAME and compare with `gzip-magic-bytes'."
  (let ((buf (generate-new-buffer "*browse-huge-tar-tmp*")) retval)
    (save-excursion			; Necessary-p?
      (set-buffer buf)
      (insert-file-contents-literally filename nil 0 2)
      (setq retval
	    (if (and (char-equal (char-after (point-min))
				 (car gzip-magic-bytes))
		     (char-equal (char-after (1+ (point-min)))
				 (cdr gzip-magic-bytes))) t nil))
      (kill-buffer buf)
      (identity retval)))) ;; Is this equiv to 'C' return(retval)?

(provide 'browse-huge-tar)

;;; browse-huge-tar.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/quack.el0000775000000000000000000060535012230377265020705 0ustar  ;;; quack.el --- enhanced support for editing and running Scheme code

(defconst quack-copyright    "Copyright (C) 2002-2012 Neil Van Dyke")
(defconst quack-copyright-2  "Portions Copyright (C) Free Software Foundation")
;; Emacs-style font-lock specs adapted from GNU Emacs 21.2 scheme.el.
;; Scheme Mode menu adapted from GNU Emacs 21.2 cmuscheme.el.

(defconst quack-version      "0.47")
(defconst quack-author-name  "Neil Van Dyke")
(defconst quack-author-email "neil@neilvandyke.org")
(defconst quack-web-page     "http://www.neilvandyke.org/quack/")

(defconst quack-legal-notice
  "This 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 2, or (at your option) any later version.  This 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.  See
http://www.gnu.org/licenses/ for details.  For other licenses and consulting,
please contact Neil Van Dyke.")

(defconst quack-cvsid "$Id: quack.el,v 1.4 2013/10/15 17:14:52 psg Exp $")

;;; Commentary:

;; INTRODUCTION:
;;
;;     Quack enhances Emacs support for Scheme programming.
;;
;;     Install Quack rather than following non-Quack-based tutorials on how to
;;     set up Emacs for Scheme.
;;
;;     The name "Quack" was a play on "DrScheme".
;;
;;     Quack is dedicated to Yosh, naturally.

;; COMPATIBILITY:
;;
;;     GNU Emacs 23 and 22 -- Yes.  Quack is now developed under GNU Emacs 23
;;     on a GNU/Linux system, which is the preferred platform for Quacksmokers.
;;     Quack should work under GNU Emacs 23 on any Un*x-like OS.  Reportedly,
;;     Quack also works with GNU Emacs 22 on Apple Mac OS X and Microsoft
;;     Windows (NT, 2000, XP), but the author has no means of testing on those
;;     platforms.
;;
;;     GNU Emacs 21 -- Probably, but no longer tested.
;;
;;     GNU Emacs 20 -- Probably mostly.  When last tested. Some of the menus do
;;     not work properly, due to a bug in easymenu.el (which the FSF will not
;;     fix, since they no longer support Emacs 20).  Nested block comments are
;;     not fontified correctly.  Pretty-lambda does not work.  Quack runs less
;;     efficiently in 20 than 21, due to the lack of standard hash tables.
;;
;;     XEmacs 21 -- Probably mostly, but no longer tested.  Block comment
;;     fontification is not yet supported under XEmacs 21, due to what appears
;;     to be a bug in 21.4 font-lock.  Pretty-lambda does not work.  XEmacs
;;     Quacksmokers who always want the latest and greatest Quack should
;;     consider GNU Emacs 21 -- Quack treats XEmacs like a high-maintenance
;;     redheaded stepchild.

;; INSTALLATION:
;;
;;     To install, put this file (`quack.el') somewhere in your Emacs load
;;     path, and add the following line to your `.emacs' file:
;;
;;         (require 'quack)
;;
;;     If you don't know what your Emacs load path is, try invoking the command
;;     "C-h v load-path RET" or consulting the Emacs manual.
;;
;;     Note to advanced Emacsers: Byte-compiled `quack.elc' files generally are
;;     *not* portable between Emacs implementations, nor between different
;;     versions of the same implementation.
;;
;;     You will also need the GNU `wget' program, which Quack uses for
;;     downloading SRFI indexes.  This popular program is included in most
;;     GNU/Linux distributions and is available for most other platforms.
;;
;;     Note to PLT Scheme users: If you do not already have the PLT manuals
;;     installed, they can be downloaded from 
;;     `http://download.plt-scheme.org/doc/' and installed in your PLT `doc'
;;     collection.  If Quack is not finding installed PLT manuals, then be sure
;;     that the `quack-pltcollect-dirs' variable contains the appropriate
;;     collection directory (if it does not, then either set the `PLTHOME'
;;     and/or `PLTCOLLECTS' environment variables appropriately, or set
;;     `quack-pltcollect-dirs').

;; KEY BINDINGS:
;;
;;     The key bindings that Quack adds to `scheme-mode' include:
;;
;;         C-c C-q m   View a manual in your Web browser.
;;         C-c C-q k   View the manual documentation for a keyword
;;                     (currently only works for PLT manuals).
;;         C-c C-q s   View an SRFI.
;;         C-c C-q r   Run an inferior Scheme process.
;;         C-c C-q f   Find a file using context of point for default.
;;         C-c C-q l   Toggle `lambda' syntax of `define'-like form.
;;         C-c C-q t   Tidy the formatting of the buffer.
;;
;;     One additional command that does not currently have a standard binding
;;     is `quack-dired-pltcollect', which prompts for a PLT collection name and
;;     creates a Dired buffer on the collection's directory.  (A future version
;;     of Quack may integrate this functionality into a more generalized
;;     documentation navigation interface.)

;; RELEASE ANNOUNCEMENTS EMAIL:
;;
;;     To receive email notification when a new Quack version is released, ask
;;     neil@neilvandyke.org to add you to the moderated `scheme-announce' list.

;; HISTORY:
;;
;;     Version 0.47 (2012-11-15):
;;         * Added indent for `call-with-' file variants and semaphore.
;;         * Added font and indent for `with-handlers*', `define-runtime-path',
;;           `match-let'.
;;
;;     Version 0.46 (2012-06-20):
;;         * Added indent for `letrec-values'.
;;         * Corrected date on history for version 0.45.
;;
;;     Version 0.45 (2012-06-18):
;;         * Added a bunch of indent rules for Scribble definition forms
;;           and Racket sequence/iterator stuff, plus Overeasy `test-section'.
;;
;;     Version 0.44 (2012-04-11):
;;         * Added indent and fontify for `struct', `module+', `module*'.
;;         * Changed intent for `module' from `defun' to 2.
;;         * Added fontify for `define-syntax-class',
;;           `define-splicing-syntax-class', `begin-for-syntax'.
;;         * Changed `define-struct' fontify.
;;
;;     Version 0.43 (2011-08-23):
;;         * Add indent and fontify for "syntax-parse".
;;         * Added another compile error regexp for Racket backtraces.
;;
;;     Version 0.42 (2011-07-30):
;;         * Added compile error regexp for "raco".
;;
;;     Version 0.41 (2011-06-04)
;;         * Added `sxml-match' to `scheme-indent-function'.
;;
;;     Version 0.40 (2010-12-22)
;;         * Added indent rules for Racket `let:', `let*:', and `match'.  And
;;           a provisional rule for `define:'.
;;
;;     Version 0.39 (2010-10-18)
;;         * Renamed "typed/scheme" to "typed/racket".
;;
;;     Version 0.38 (2010-10-14)
;;         * Replaced old PLT Scheme programs in `quack-programs' with Racket.
;;         * Added Racket ".rkt" and ".rktd" filename extensions.
;;         * Added some Racket keywords for fontifying.
;;
;;     Version 0.37 (2009-06-29)
;;         * Disabled highlighting of "Compilation started at" lines.
;;
;;     Version 0.36 (2009-05-27)
;;         * Made `#:' ``colon keywords'' fontify in PLT-ish mode.
;;         * Added PLT `r6rs' and `typed-scheme' languages to `quack-programs'.
;;
;;     Version 0.35 (2009-02-24)
;;         * Added `interpreter-mode-alist' support, so Scheme scripts with "#!"
;;           start in `scheme-mode'.
;;         * Added PLT `parameterize-break'.
;;         * Improved `compile' mode for PLT 4.x tracebacks when there is only
;;           file, line, and column, but no additional information.
;;
;;     Version 0.34 (2009-02-19)
;;         * Added fontify and indent support for PLT `define/kw', `lambda/kw',
;;          `parameterize*'.
;;         * Fontify Unix "#!" cookie in PLT-ish font-lock.
;;         * Changed reference to `quack-announce' email list to
;;           `scheme-announce'.
;;         * Added PLT `default-load-handler' to
;;          `quack-compilation-error-regexp-alist-additions'
;;         * Changed some face ":height" attributes.
;;
;;     Version 0.33 (2008-07-31)
;;         * Added handlers for some PLT 4.0.1 "setup-plt" messages.
;;
;;     Version 0.32 (2008-06-19)
;;         * Added to `quack-programs'.
;;         * Updated compatibility comments.
;;         * Added indent rule for `for/fold'.
;;
;;     Version 0.31 (2008-05-03)
;;         * Added `defvar' for `quack-pltish-font-lock-keywords', so that the
;;           GNU Emacs 22.1 compiler doesn't complain about assignment to a free
;;           variable.
;;         * Changed banner regexp for MzScheme for v3.99.x.
;;         * Set `dynamic-wind' `scheme-indent-function to 0, when the default
;;           is 3.  It was just taking up too much space.  DrScheme's
;;           indentation seems to be equivalent -1, so there is precedent for
;;           something different.  We generally respect Emacs indentation
;;           convention.
;;         * Added fontifying and indent for PLT `define-for-syntax',
;;           `define-values-for-syntax', `quasisyntax', `quasisyntax/loc',
;;           `syntax', `syntax/loc', `define-parameters'.
;;         * Advise `scheme-interactively-start-process' for GNU Emacs 22.
;;         * Removed TODO comment that mentioned using `(current-eventspace
;;           (make-eventspace))' under `mred', as Robby Findler has indicated
;;           that is not good advice.
;;
;;     Version 0.30 (2007-06-27)
;;         * Emacs 22 compatibility change: `string-to-number' instead of
;;           `string-to-int'.  Thanks to Charles Comstock.
;;
;;     Version 0.29 (2006-11-12)
;;         * Fixed `quack-bar-syntax-string', which caused vertical bar
;;           characters to be treated as whitespace.  Thanks to Eric Hanchrow
;;           for reporting.
;;
;;     Version 0.28 (2005-05-14)
;;         * Added `quack-smart-open-paren-p'.
;;         * Changed `scheme-indent-function' for `parameterize' from `defun'
;;           to `1'.
;;         * In `quack-pltish-keywords-to-fontify': added `quasiquote',
;;           `unquote', and `unquote-splicing'.
;;         * Added ".mzschemerc" to `auto-mode-alist'.
;;         * Added a little extra threesemi fontification for Funcelit and
;;           similar Texinfo markup formats.
;;
;;     Version 0.27 (2004-12-19)
;;         * For Gambit-C, added REPL banner fontifying, `quack-manuals' entry,
;;           and "gsi ~~/syntax-case.scm -" `quack-programs' entry.
;;         * Changed "[PLT]" prefix on PLT manuals to "PLT", to make it easier
;;           to type.
;;         * Minor changes to reflect "MIT Scheme" becoming "MIT/GNU Scheme".
;;
;;     Version 0.26 (2004-07-14)
;;         * Added fontifying of a bunch of "define-"* syntax from Chicken.
;;
;;     Version 0.25 (2004-07-09)
;;         * Added `define-record-type' to `quack-pltish-keywords-to-fontify'.
;;         * Added "csi -hygienic" to `quack-programs'.
;;         * In `quack-manuals', replaced PLT-specific `r5rs' and `t-y-scheme'
;;           with generic ones.
;;         * Updated URL in `quack-manuals' for 3rd ed. of `tspl'.
;;         * `quack-view-manual' completions no longer include symbols.
;;         * `quack-view-manual' completion default is now "R5RS".
;;
;;     Version 0.24 (2004-05-09)
;;         * Made `quack-pltish-keywords-to-fontify' and
;;           `quack-emacs-keywords-to-fontify' custom changes update
;;           immediately.  Bug reported by Taylor Campbell.
;;         * Removed some non-syntax names from  
;;           `quack-pltish-keywords-to-fontify'.
;;         * Documentation changes.
;;
;;     Version 0.23 (2003-11-11)
;;         * `quack-local-keywords-for-remote-manuals-p' can now have the value
;;           of the symbol `always', to work around a defect in some versions
;;           of Microsoft Windows.  Thanks to Bill Clementson.
;;         * `quack-w3m-browse-url-other-window' no longer splits a `*w3m*'
;;           buffer.
;;         * Added indent and `quack-pltish-keywords-to-fontify' rules for
;;           `c-lambda' and `c-declare'.
;;
;;     Version 0.22 (2003-07-03)
;;         * `quack-newline-behavior' controls the RET key behavior in Scheme
;;           buffers.
;;         * In `quack-manuals', added Chez Scheme, and updated Chicken.
;;         * Added error message navigation to `compile' for PLT `setup-plt'.
;;         * Partial fix for Quack global menu disappearing from the main menu
;;           bar in XEmacs.  Thought it used to work, but it doesn't in XEmacs
;;           21.4.12.
;;
;;     Version 0.21 (2003-05-28)
;;         * `quack-find-file' is faster in many cases due to fix to
;;           `quack-backward-sexp'.
;;         * Added auto-mode-alist for `.ccl', `.stk', and `.stklos' files.
;;         * Indent rule additions/changes for `chicken-setup' and `unit/sig'.
;;
;;     Version 0.20 (2003-05-04)
;;         * Added indent and fontify for SRFI-8 "receive".
;;         * Added indent and fontify for additional PLT syntax.
;;         * Added `quack-fontify-threesemi-p'.
;;         * `quack-tidy-buffer' sets `fill-prefix' to nil when running.
;;         * Added messages to `run-scheme', if only to get rid of annoying 
;;           "Mark set" message.
;;         * Added "mzscheme -M errortrace" to `quack-programs'.
;;         * `quack-dired-pltcollect' prompt defaults to `mzlib'.
;;         * "Update SRFI Index" menu item has moved to top of menu, mainly to
;;           avoid usability issue in a particular Emacs menu implementation.
;;         * Several code quality improvements sent by Stefan Monnier will be
;;           in the next release.
;;
;;     Version 0.19 (2003-03-04)
;;         * Commands such as `scheme-load-file' now start a Scheme process if
;;           none is found.
;;         * Bugfix for using `match-string-no-properties' when we meant
;;           `quack-match-string-no-properties'.  (Thanks to Noel Welsh.)
;;
;;     Version 0.18 (2003-05-02)
;;         * Removed uses of `(regexp-opt LIST t)', since XEmacs21 does not
;;           create match data.  (Thanks to Garrett Mitchener for debugging.)
;;         * Added to `quack-programs' and `quack-manuals'.
;;         * Added pretty-case-lambda.
;;         * Changed PLT documentation URL function.
;;
;;     Version 0.17 (2003-01-03)
;;         * Pretty-lambda is supported well under GNU Emacs 21, when using PLT
;;           Style fontification.  Enable via the Options menu.  (Based on
;;           approach by Stefan Monnier; suggested by Ray Racine.)
;;         * Various faces now have separate defaults for `light' and `dark'
;;           backgrounds, so may now look better on dark backgrounds.
;;           (Suggested by Eli Barzilay.)
;;         * `quack-find-file' now respects `insert-default-directory' when
;;           there is no default file.  (Thanks to Eli Barzilay.)
;;         * Most of the special w3m support has been moved to a separate
;;           package, `w3mnav' (`http://www.neilvandyke.org/w3mnav/').
;;           `quack-w3m-browse-url-other-window' has been added.
;;
;;     Version 0.16 (2002-12-16)
;;         * `quack-insert-closing' now calls `blink-paren-function'.  (Thanks
;;           to Guillaume Marceau and Steve Elkins for reporting this.)
;;         * Now uses PLT 202 manuals.  Added "PLT Framework" manual.
;;         * Added `quack-pltish-module-defn-face'.
;;         * Added some PLTish font-lock keywords.
;;
;;     Version 0.15 (2002-11-21)
;;         * "Keywords" are now fontified in PLT Style fontification mode.
;;         * Definition names are now blue by default in PLT Style.
;;         * Symbol literals with vertical bars are now fontified in PLT Style.
;;         * New `quack-manuals-webjump-sites' function for people who prefer
;;           to use the `webjump' package for invoking manuals.
;;         * New `quack-quiet-warnings-p' option.
;;         * New `quack-pltish-class-defn-face' face.
;;
;;     Version 0.14 (2002-10-18)
;;         * Fix for `quack-view-manual' interactive prompting (thanks to Marko
;;           Slyz for reporting this).
;;         * `quack-emacsw3m-go-next' and `quack-emacsw3m-go-prev' now work
;;           with GTK reference documentation (not that this has anything to do
;;           with Scheme).
;;         * Added SLIB to `quack-manuals'.
;;         * Added comment about installing PLT manuals (thanks to Marko).
;;         * We now call the canonical version of Emacs "GNU Emacs," instead of
;;           "FSF Emacs".
;;
;;     Version 0.13 (2002-09-21)
;;         * Bugfix: No longer drop SRFI index entries on the floor.
;;
;;     Version 0.12 (2002-09-20)
;;         * New "View SRFI" menu.  Select "Update SRFI Index" if the submenus
;;           "Draft", "Final", and "Withdrawn" are disabled.
;;         * Most options are now settable via "Options" menu.
;;         * PLT collections are no longer scanned when building "View Manuals"
;;           menu.
;;         * "View Keyword Docs..." back on Scheme Mode menu in addition to
;;           Quack menu.
;;         * Various `defcustom' variables have been made to dynamically update
;;           relevant program state when changed.
;;         * Under GNU Emacs 20, dynamic menus still do not work -- they now
;;           display, but do not perform the selected action.  Will do more
;;           debugging after this release.
;;         * '[' and ']' keys work in emacs-w3m of MIT Scheme manuals.
;;
;;     Version 0.11 (2002-09-17)
;;         * Menus now work under XEmacs.  Also now partly broken for Emacs 20.
;;         * New global "Quack" menu.  Disable with `quack-global-menu-p'.
;;         * New "View Manual" submenu under GNU Emacs 21 and XEmacs (GNU Emacs
;;           20 is stuck with the old "View Manual..." menu item).
;;         * Fix for `quack-pltcollects-alist' to include PLT `doc' collection,
;;           which was preventing local manuals from being used.
;;         * `quack-manuals' now includes `t-y-scheme'.
;;         * `quack-view-in-different-browser' command that spawns alternative
;;           Web browser from the special emacs-w3m support, bound to `B'.  For
;;           when you normally view manuals in an Emacs window, but
;;           occasionally want to view a particular page in normal Web browser.
;;         * More `scheme-indent-function' properties set.
;;         * `quack-about' command.
;;         * Fix to `quack-keyword-at-point'.
;;
;;     Version 0.10 (2002-09-11)
;;         * `quack-view-srfi' now prompts with completion, including titles
;;           for all SRFIs.  The SRFI titles are fetched from the official SRFI
;;           Web site using the GNU Wget program, and cached locally.
;;         * `quack-view-srfi' also now defaults to the SRFI number at or near
;;           the point.
;;         * `quack-dir' variable specifies a directory where Quack should
;;           store its persistent data files (e.g., cached SRFI indexes), and
;;           defaults to "~/.quack/".
;;         * New `quack-tidy-buffer' command.  [C-c C-q t] is now bound to
;;           this; [C-c C-q l] ("l" as in "lambda) is now the official binding
;;           for `quack-toggle-lambda'.
;;         * `quack-find-file' now recognizes PLT `dynamic-require' form.
;;         * Fix to make `quack-looking-at-backward' preserve match data.
;;         * Fix for benign bug in `quack-parent-sexp-search'.
;;
;;     Version 0.9 (2002-09-04)
;;         * Quack now works under XEmacs 21, except no menus are currently
;;           defined (that will come in a later version) and block comments
;;           aren't fontified.
;;         * `quack-toggle-lambda' command toggles a `define' form between
;;           explicit and implicit `lambda' syntax.
;;         * `quack-dired-pltcollect' feature prompts for a PLT collection name
;;           and creates a Dired on the collection.
;;         * `)' and `]' keys are bound to insert a closing character that
;;           agrees with the opening character of the sexp.
;;         * Nested `#|' comment blocks are now fontified mostly correctly
;;           under GNU Emacs 21.
;;         * Fix to `quack-parent-sexp-search'.
;;         * Fix for PLT manual keywords lookup under Emacs 20.
;;         * `quack-manuals' URLs for assorted implementation manuals now point
;;           to canonical Web copies.
;;         * No longer warns about PLT manual keywords file found without HTML.
;;         * `find-file' key bindings are automatically remapped to
;;           `quack-find-file' in Scheme buffers.
;;         * Both PLT-style and Emacs-style fontification now work with the
;;           `noweb-mode' package.  Tested under GNU Emacs 21 with
;;           Debian `nowebm' package version 2.10c-1.
;;         * Added to `quack-emacsish-keywords-to-fontify'.
;;         * Disabled fontification of named `let'.
;;         * Renamed "collect" in PLT identifiers to "pltcollect".
;;         * `auto-mode-alist' set more aggressively.
;;
;;     Version 0.8 (2002-08-25)
;;         * PLT package file viewing mode.  This is mainly used to easily
;;           inspect a ".plt" package before installing it via DrScheme or
;;           "setup-plt".
;;         * No longer warns about `font-lock-keywords' when `noweb-mode'
;;           package is installed.
;;
;;     Version 0.7 (2002-08-22)
;;         * Now works on GNU Emacs 20 (though people are still encouraged to
;;           upgrade to GNU Emacs 21 if they are able).
;;         * `quack-manuals' now includes MIT Scheme and Chicken manuals
;;           (currently where Debian GNU/Linux puts them).
;;         * `quack-view-srfi' command.
;;         * Named-`let' name is fontified like a PLTish definition name.
;;         * `define-record' and `define-opt' fontified.
;;         * Scheme Mode is forced in `auto-mode-alist' for ".sch" files.
;;         * Fix to `quack-backward-sexp'.
;;         * `quack-warning' messages get your attention.
;;         * `quack-pltrequire-at-point-data-1' search depth limited.
;;
;;     Version 0.6 (2002-08-20)
;;         * `quack-find-file' now supports multi-line PLT `require' forms.
;;         * When `emacs-w3m' is used, the keys "[", "]", and "t" are bound to
;;           navigate through PLT manuals like in Info mode.
;;         * Names highlighted in PLT-style fontification of `defmacro',
;;           `defmacro-public', `defsyntax'.
;;         * Advised `run-scheme' no longer prompts when there is already a
;;           running Scheme.
;;         * "csi" (Chicken interpreter) added to `quack-programs' default.
;;         * Forces `auto-mode-alist' for ".scm" files to `scheme-mode'
;;           (two can play at that game, `bee-mode'!).
;;         * To-do comments moved from the top of the file to throughout code.
;;
;;     Version 0.5 (2002-08-15)
;;         * New `quack-find-file' permits quick navigation to files indicated
;;           by a PLT Scheme `require' form under the point.  Currently only
;;           works when the "(require" string is on the same line as point.
;;         * Improved PLT-style fontification.  Most noticeable difference is
;;           that names in many definition forms are boldfaced.  See
;;           `quack-pltish-fontify-definition-names-p' option.
;;         * `quack-collects-alist' added.
;;         * "~/plt/" has been removed from `quack-collect-dirs' default.
;;         * Unnecessary syntax table settings have been removed.
;;         * Reduced memory usage in some cases, via explicit GC calls.
;;
;;     Version 0.4 (2002-08-07)
;;         * Functionality adapted from author's `giguile.el' package:
;;             - Enhanced `run-scheme' behavior.  `quack-run-mzscheme',
;;               `quack-run-mred', and `quack-remove-run-scheme-menu-item-p'
;;               are obsolete.
;;             - Enhanced `switch-to-scheme' behavior.
;;             - Options menu.
;;             - Indent rules for a few Guile-isms.
;;         * Inferior Scheme Mode now uses the preferred fontification method.
;;         * Now uses the PLT-bundled version of R5RS manual, which permits
;;           keyword searching.
;;         * `quack-banner-face' for the MzScheme/MrEd banner in REPL buffer.
;;         * This code includes a start on toolbars and XEmacs21 portability,
;;           but neither feature is yet functional.
;;
;;     Version 0.3 (2002-08-01)
;;         * PLT-style fontification added, except for quoted lists.  Emacs-
;;           style fontification still available; see `quack-fontify-style'.
;;         * `emacs-w3m' package support for lightweight viewing of PLT manuals
;;           in Emacs window.  If you install the `emacs-w3m' package, then you
;;           can change the new `quack-browse-url-browser-function' option to
;;           use it.
;;         * Quack menu items added to Scheme Mode menu.  "Run Scheme" item
;;           is removed by default; see `quack-remove-run-scheme-menu-item-p'.
;;         * MrEd REPL supported with `quack-run-mred'.
;;         * Better default for `quack-collect-dirs'.
;;         * More `scheme-indent-function' settings.
;;         * Bugfix for `quack-prompt-for-kwmatch-choice'.
;;         * Bugfix for font-lock keywords getting set too early.
;;         * Now byte-compiles without warnings/errors.
;;
;;     Version 0.2 (2002-07-28)
;;         * Manual keywords lookup.
;;         * Other minor changes.
;;
;;     Version 0.1 (2002-07-18)
;;         * Initial release.

;; ADMONISHMENT TO IMPRESSIONABLE YOUNG SCHEME STUDENTS:
;;
;;     Quack should by no means be construed as a model of good programming,
;;     much less of good software engineering.  Emacs is by nature a complex
;;     system of interacting kludges.  To get Emacs to do useful new things is
;;     to artfully weave one's extensions into a rich tapestry of sticky duct
;;     tape.  Also, Quack usually only got hacked on when I was stuck in a busy
;;     lobby for an hour with a laptop and unable to do real work.

;;; Code:

;; Dependencies:

(require 'advice)
(require 'cmuscheme)
(require 'compile)
(require 'custom)
(require 'easymenu)
(require 'font-lock)
(require 'scheme)
(require 'thingatpt)

(unless (fboundp 'customize-save-variable)
  (autoload 'customize-save-variable "cus-edit"))

;; Custom Variables:

(defgroup quack nil
  "Enhanced support for editing and running Scheme code."
  :group  'scheme
  :prefix "quack-"
  :link   '(url-link "http://www.neilvandyke.org/quack/"))

(defcustom quack-dir "~/.quack"
  "*Directory where Quack stores various persistent data in file format."
  :type  'string
  :group 'quack)

(defcustom quack-scheme-mode-keymap-prefix "\C-c\C-q"
  "*Keymap prefix string for `quack-scheme-mode-keymap'.

One of the nice things about having C-q in the prefix is that it is unlikely to
be already be in use, due to the historical reality of software flow control
\(and the fact that it is hard to type).  If your C-q doesn't seem to be going
through, then you have several options: disable flow control (if it is safe to
do so), change the value of this variable, or see the Emacs documentation for
`enable-flow-control-on'."
  :type  'string
  :group 'quack)

(defcustom quack-remap-find-file-bindings-p t
  "Whether to remap `find-file' key bindings to `quack-find-file'.
The local map in Scheme Mode and Inferior Scheme Mode buffers is used."
  :type  'boolean
  :group 'quack)

(defcustom quack-global-menu-p t
  "*Whether to have a \"Quack\" menu always on the menu bar."
  :type  'boolean  :group 'quack)

(defcustom quack-tabs-are-evil-p t
  "*Whether Quack should avoid use of Tab characters in indentation."
  :type  'boolean
  :group 'quack)

(defcustom quack-browse-url-browser-function nil
  "*Optional override for `browse-url-browser-function'.

If non-nil, overrides that variable for URLs viewed by `quack-browse-url'."
  :type '(choice (const    :tag "Do Not Override" nil)
                 (function :tag "Function")
                 (alist    :tag "Regexp/Function Association List"
                           :key-type regexp :value-type function))
  :group 'quack)

(defcustom quack-manuals                ; TODO: Options menu.

  ;; TODO: If we make this so users are likely to want to override parts of it,
  ;;       then introduce `quack-manuals-defaults' variable with this in it,
  ;;       and let users edit `quack-manuals-overrides' which are keyed on the
  ;;       ID symbol.

  ;; TODO: Have a way for finding docs on the local filesystem, and/or
  ;;       permitting a user to easily specify location.

  ;; TODO: Provide a way of specifying alternative access means so that, for
  ;;       example, we can look for R5RS first in locally-installed PLT
  ;;       collection, then in one of various non-PLT directories it might be
  ;;       mirrored, then remote PLT copy using local PLT keywords file, then
  ;;       the canonical HTML copy on the Web...  Maybe even permit Info
  ;;       format.  Let's just reinvent the Web, while we're at it.

  '(

    (r5rs "R5RS"
          "http://www.schemers.org/Documents/Standards/R5RS/HTML/"
          nil)

    (bigloo
     "Bigloo"
     "http://www-sop.inria.fr/mimosa/fp/Bigloo/doc/bigloo.html"
     ;;"file:///usr/share/doc/bigloo/manuals/bigloo.html"
     nil)

    (chez
     "Chez Scheme User's Guide"
     "http://www.scheme.com/csug/index.html"
     nil)

    (chicken
     "Chicken User's Manual"
     "http://www.call-with-current-continuation.org/manual/manual.html"
     ;;"file:///usr/share/doc/chicken/manual.html"
     nil)

    (gambit
     "Gambit-C home page"
     "http://www.iro.umontreal.ca/~gambit/")

    (gauche
     "Gauche Reference Manual"
     "http://www.shiro.dreamhost.com/scheme/gauche/man/gauche-refe.html"
     nil)

    (mitgnu-ref
     "MIT/GNU Scheme Reference"
     "http://www.gnu.org/software/mit-scheme/documentation/scheme.html"
     ;;"http://www.swiss.ai.mit.edu/projects/scheme/documentation/scheme.html"

     ;;"file:///usr/share/doc/mit-scheme/html/scheme.html"
     nil)

    (mitgnu-user
     "MIT/GNU Scheme User's Manual"
     "http://www.gnu.org/software/mit-scheme/documentation/user.html"
     ;;"http://www.swiss.ai.mit.edu/projects/scheme/documentation/user.html"
     ;;"file:///usr/share/doc/mit-scheme/html/user.html"
     nil)

    (mitgnu-sos
     "MIT/GNU Scheme SOS Reference Manual"
     "http://www.gnu.org/software/mit-scheme/documentation/sos.html"
     ;;"http://www.swiss.ai.mit.edu/projects/scheme/documentation/sos.html"
     ;;"file:///usr/share/doc/mit-scheme/html/sos.html"
     nil)

    (plt-mzscheme  "PLT MzScheme: Language Manual"                plt t)
    (plt-mzlib     "PLT MzLib: Libraries Manual"                  plt t)
    (plt-mred      "PLT MrEd: Graphical Toolbox Manual"           plt t)
    (plt-framework "PLT Framework: GUI Application Framework"     plt t)
    (plt-drscheme  "PLT DrScheme: Programming Environment Manual" plt nil)
    (plt-insidemz  "PLT Inside PLT MzScheme"                      plt nil)
    (plt-tools     "PLT Tools: DrScheme Extension Manual"         plt nil)
    (plt-mzc       "PLT mzc: MzScheme Compiler Manual"            plt t)
    (plt-r5rs      "PLT R5RS"                                     plt t)

    (scsh
     "Scsh Reference Manual"
     "http://www.scsh.net/docu/html/man-Z-H-1.html"
     ;;"file:///usr/share/doc/scsh-doc/scsh-manual/man-Z-H-1.html"
     nil)

    (sisc
     "SISC for Seasoned Schemers"
     "http://sisc.sourceforge.net/manual/html/"
     nil)

    (htdp       "How to Design Programs"
                "http://www.htdp.org/"
                nil)
    (htus       "How to Use Scheme"
                "http://www.htus.org/"
                nil)
    (t-y-scheme "Teach Yourself Scheme in Fixnum Days"
                "http://www.ccs.neu.edu/home/dorai/t-y-scheme/t-y-scheme.html"
                nil)
    (tspl       "Scheme Programming Language (Dybvig)"
                "http://www.scheme.com/tspl/"
                nil)
    (sicp       "Structure and Interpretation of Computer Programs"
                "http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-4.html"
                nil)
    (slib       "SLIB"
                "http://swissnet.ai.mit.edu/~jaffer/SLIB.html"
                nil)
    (faq        "Scheme Frequently Asked Questions"
                "http://www.schemers.org/Documents/FAQ/"
                nil))
  "*List of specifications of manuals that can be viewed.

Each manual specification is a list of four elements:

    (SYMBOL TITLE LOCATION USE-KEYWORDS-P)

where SYMBOL is a short symbol that identifies the manual, TITLE is a string,
LOCATION is either a string with the URL of the manual or the symbol `plt',
and USE-KEYWORDS-P is `t' or `nil'.

If LOCATION is `plt', then Quack treats it as a PLT bundled manual, looking for
the HTML and keyword files in `quack-pltcollect-dirs', and optionally providing
keyword lookup if USE-KEYWORDS-P is `t'.  Remote canonical copies of the
manuals will be used if local copies cannot be found.

If LOCATION is a URL, then USE-KEYWORDS-P must be `nil'."
  :type  '(repeat (list (symbol :tag "Identifying Symbol")
                        (string :tag "Title String")
                        (choice :tag "Location"
                                (string :tag "URL")
                                (const  :tag "PLT Bundled Manual" plt))
                        (boolean :tag "Use Keywords?")))
  :group 'quack)

(defcustom quack-local-keywords-for-remote-manuals-p t
  "*If non-nil, Quack will use canonical remote Web URLs when there is a local
keyword file for a PLT manual but no local HTML files.  (This feature was
prompted by the Debian 200.2-3 package for MzScheme, which includes keyword
files but not HTML files.)  If the symbol `always', then Quack will always use
remote Web manuals for keywords lookup, even if local HTML files exist, as a
workaround for how some versions of Emacs interact with some versions of
Microsoft Windows \(inexplicably discarding the fragment identifier from `file'
scheme URI\)."
  :type       '(choice (const :tag "Permit"    t)
                       (const :tag "Forbid"     nil)
                       (const :tag "Always" always))
  :group      'quack
  :set        'quack-custom-set
  :initialize 'custom-initialize-default)

(defcustom quack-srfi-master-base-url "http://srfi.schemers.org/"
  ;; Note: Intentionally not letting user change this through the options menu.
  "*The base URL for the master SRFI Web pages.
The SRFI index files should be immediately beneath this."
  :type   'string
  :group  'quack)

(defcustom quack-pltcollect-dirs
  (let ((good '()))
    (mapcar (function (lambda (dir)
                        (and dir
                             (not (assoc dir good))
                             (file-directory-p dir)
                             (setq good (nconc good (list dir))))))
            `(,@(let ((v (getenv "PLTCOLLECTS")))
                  (and v (split-string v ":")))
                ,(let ((v (getenv "PLTHOME")))
                   (and v (expand-file-name "collects" v)))
                ,@(mapcar 'expand-file-name
                          '("/usr/lib/plt/collects"
                            "/usr/local/lib/plt/collects"))))
    good)
  "*PLT collection directories.
Listed in order of priority."
  :type       '(repeat directory)
  :group      'quack
  :set        'quack-custom-set
  :initialize 'custom-initialize-default)

(defcustom quack-fontify-style 'plt
  "*Which font-lock fontification style to use.

If symbol `plt', an approximation of PLT DrScheme 200 Check Syntax
fontification will be used.  If symbol `emacs', then fontification in the style
of GNU Emacs' Scheme Mode with extensions will be used.  If nil, then Quack
will not override the default Scheme Mode fontification."
  :type       '(choice (const :tag "PLT Style"                plt)
                       (const :tag "Extended GNU Emacs Style" emacs)
                       (const :tag "Emacs Default"            nil))
  :group      'quack
  :set        'quack-custom-set
  :initialize 'custom-initialize-default)

(defcustom quack-pltish-fontify-definition-names-p t
  "*If non-nil, fontify names in definition forms for PLT-style fontification.

This only has effect when `quack-fontify-style' is `plt'."
  :type       'boolean
  :group      'quack
  :set        'quack-custom-set
  :initialize 'custom-initialize-default)

(defcustom quack-pltish-fontify-keywords-p t
  ;; TODO: Rename this from "keywords" to "syntax-keywords", here, and in for
  ;; face names.
  "*If non-nil, fontify keywords in PLT-style fontification.

This only has effect when `quack-fontify-style' is `plt'."
  :type       'boolean
  :group      'quack
  :set        'quack-custom-set
  :initialize 'custom-initialize-default)

(defcustom quack-pltish-keywords-to-fontify
  ;; TODO: These are currently R5RS and some SRFI special syntax plus a bunch
  ;; of PLT, especially PLT 200 class.ss, and some "define-"* variants from
  ;; various dialects, plus some Racket 5.0.2...  The dumbness of this kind of
  ;; highlighting without regard to context is not really satisfactory.
  '(

    "and" "begin" "begin-for-syntax"
    "begin0" "c-declare" "c-lambda" "case" "case-lambda" "class"
    "class*" "class*/names" "class100" "class100*" "compound-unit/sig" "cond"
    "cond-expand" "define" "define-class" "define-compound-unit"
    "define-const-structure"
    "define-constant" "define-embedded" "define-entry-point" "define-external"
    "define-for-syntax" "define-foreign-record" "define-foreign-type"
    "define-foreign-variable" "define-generic" "define-generic-procedure"
    "define-inline" "define-location" "define-macro" "define-method"
    "define-module" "define-opt" "define-public" "define-reader-ctor"
    "define-record" "define-record-printer" "define-record-type"
    "define-runtime-path"
    "define-signature"
    "define-splicing-syntax-class"
    "define-struct"
    "define-structure"
    "define-syntax"
    "define-syntax-class"
    "define-syntax-set" "define-values" "define-values-for-syntax"
    "define-values/invoke-unit/infer"
    "define-values/invoke-unit/sig" "define/contract" "define/override"
    "define/private" "define/public" "define/kw"
    "delay" "do" "doc" "else" "exit-handler" "field"
    "if" "import" "inherit" "inherit-field" "init" "init-field" "init-rest"
    "instantiate" "interface" "lambda" "lambda/kw" "let" "let*" "let*-values"
    "let+"
    "let-syntax" "let-values" "let/ec" "letrec" "letrec-values" "letrec-syntax"
    "match-lambda" "match-lambda*" "match-let" "match-let*" "match-letrec"
    "match-define" "mixin" "module" "module*" "module+" "opt-lambda" "or" "override" "override*"
    "namespace-variable-bind/invoke-unit/sig" "parameterize" "parameterize*"
    "parameterize-break" "private"
    "private*" "protect" "provide" "provide-signature-elements"
    "provide/contract" "public" "public*" "quasiquote" 
    "quasisyntax" "quasisyntax/loc" "quote" "receive"
    "rename" "require" "require-for-syntax" "send" "send*" "set!" "set!-values"
    "signature->symbols" "super-instantiate" "syntax" "syntax/loc"
    "syntax-case" "syntax-case*" "syntax-error" "syntax-parse" "syntax-rules"
    "unit/sig"
    "unless" "unquote" "unquote-splicing" "when" "with-handlers" "with-handlers*" "with-method"
    "with-syntax"
    "define-type-alias"
    "define-struct:"
    "define:"
    "let:"
    "letrec:"
    "let*:"
    "lambda:"
    "match-let"
    "plambda:"
    "case-lambda:"
    "pcase-lambda:"
    "require/typed"
    "require/opaque-type"
    "require-typed-struct"
    "struct"
    "inst"
    "ann"

    )
  "*Scheme keywords to fontify when `quack-fontify-style' is `plt'."
  :type       '(repeat string)
  :group      'quack
  :set        'quack-custom-set
  :initialize 'custom-initialize-default)

(defcustom quack-emacsish-keywords-to-fontify
  '("and" "begin" "begin0" "call-with-current-continuation"
    "call-with-input-file" "call-with-output-file" "call/cc" "case"
    "case-lambda" "class" "cond" "delay" "do" "else" "exit-handler" "field"
    "for-each" "if" "import" "inherit" "init-field" "interface" "lambda" "let"
    "let*" "let*-values" "let-values" "let-syntax" "let/ec" "letrec"
    "letrec-syntax" "map" "mixin" "opt-lambda" "or" "override" "protect"
    "provide" "public" "rename" "require" "require-for-syntax" "syntax"
    "syntax-case" "syntax-error" "syntax-rules" "unit/sig" "unless" "when"
    "with-syntax")
  "*Scheme keywords to fontify when `quack-fontify-style' is `emacs'."
  :type       '(repeat string)
  :group      'quack
  :set        'quack-custom-set
  :initialize 'custom-initialize-default)

(defcustom quack-fontify-threesemi-p t
  "*Whether three-semicolon comments should be fontified differently."
  :type       'boolean
  :group      'quack
  :set        'quack-custom-set
  :initialize 'custom-initialize-default)

(defcustom quack-pretty-lambda-p nil
  "*Whether Quack should display \"lambda\" as the lambda character.

`quack-fontify-style' must be `plt'.  Only supported under GNU Emacs version
21\; not under XEmacs or older GNU Emacs.

Note: Pretty lambda requires that suitable iso8859-7 fonts be available.  Under
Debian/GNU Linux, for example, these can be downloaded and installed with the
shell command \"apt-get install 'xfonts-greek-*'\".  If iso8859-7 fonts are
unavailable for your system, please notify the Quack author."
  :type       'boolean
  :group      'quack
  :set        'quack-custom-set
  :initialize 'custom-initialize-default)

(defcustom quack-programs
  '("bigloo" "csi" "csi -hygienic" "gosh" "gracket" "gsi"
    "gsi ~~/syntax-case.scm -" "guile" "kawa" "mit-scheme" "racket"
    "racket -il typed/racket" "rs" "scheme" "scheme48" "scsh" "sisc" "stklos"
    "sxi")
  "List of Scheme interpreter programs that can be used with `run-scheme'.

These names will be accessible via completion when `run-scheme' prompts for
which program to run."
  :group      'quack
  :type       '(repeat string)
  :set        'quack-custom-set
  :initialize 'custom-initialize-default)

(defcustom quack-default-program "mzscheme"
  "Default Scheme interpreter program to use with `run-scheme'."
  :group 'quack
  :type  'string)

(defcustom quack-run-scheme-always-prompts-p t
  "`run-scheme' should always prompt for which program to run.

If nil, `run-scheme' will always use `quack-default-program' when invoked
interactively without a prefix argument; this is closest to the behavior of the
`cmuscheme' package."
  :group 'quack
  :type  'boolean)

(defcustom quack-run-scheme-prompt-defaults-to-last-p t
  "If non-nil, `run-scheme' prompt should default to the last program run."
  :group 'quack
  :type  'boolean)

(defcustom quack-remember-new-programs-p t
  "Programs are added to `quack-programs' automatically."
  :group 'gigule
  :type  'boolean)

(defcustom quack-switch-to-scheme-method 'other-window
  "Method to use for choosing a window and frame for the process buffer.

One of three symbols:
`other-window' will split display in a different window in the current frame,
splitting the current window if necessary.
`own-frame' will display the process buffer in its own frame.
`cmuscheme' will use the normal behavior of the `cmuscheme' package."
  :group  'quack
  :type   '(choice (const :tag "Other Window"       other-window)
                   (const :tag "Own Frame"          own-frame)
                   (const :tag "Cmuscheme Behavior" cmuscheme)))

(defcustom quack-warp-pointer-to-frame-p t
  "Warp mouse pointer to frame with Scheme process buffer.

When `quack-switch-to-scheme-method' is `own-frame', `switch-to-scheme' will
warp the mouse pointer to the frame displaying the Scheme process buffer."
  :group 'quack
  :type  'boolean)

(defcustom quack-newline-behavior 'newline-indent
  "*Behavior of the RET key in Scheme-Mode buffers.  The value is one of three
symbols: `newline' inserts a normal newline, `newline-indent' \(the default\)
inserts a newline and leaves the point properly indented on the new line, and
`indent-newline-indent' indents the current line before inserting a newline and
indenting the new one."
  :type '(choice (const 'newline)
                 (const 'newline-indent)
                 (const 'indent-newline-indent))
  :group 'quack)

(defcustom quack-smart-open-paren-p nil
  "The `[' can be used to insert `(' characters.
Actually, this just makes the `(' and '[' keys both insert `(', unless given a
prefix argument.  This makes typing parens easier on typical keyboards for
which `(' requires a shift modifier but `[' does not.  A later version of Quack
might add actual \"smart\" support for automatic PLT-esque insertion of `['
instead of `(' in some syntactic contexts."
  :group 'quack
  :type  'boolean)

(defcustom quack-options-persist-p t
  "Option menu settings and programs persist using the `custom' facility.

Note that the value of this option itself cannot be set persistently via the
option menu -- you must use the `customize' interface or set it manually in an
Emacs startup file.  This is by design, to avoid the risk of users accidentally
disabling their ability to set persistent options via the option menu."
  :group 'quack
  :type  'boolean)

(defcustom quack-quiet-warnings-p t     ; TODO: Options menu.
  "Warning messages are quiet and subtle."
  :group 'quack
  :type  'boolean)

(defconst quack-pltish-comment-face 'quack-pltish-comment-face)
(defface  quack-pltish-comment-face
  '((((class color) (background light)) (:foreground "cyan4"))
    (((class color) (background dark))  (:foreground "cyan1"))
    (t                                  (:slant italic)))
  "Face used for comments when `quack-fontify-style' is `plt'."
  :group 'quack)

(defconst quack-pltish-selfeval-face 'quack-pltish-selfeval-face)
(defface  quack-pltish-selfeval-face
  '((((class color) (background light)) (:foreground "green4"))
    (((class color) (background dark))  (:foreground "green2"))
    (t                                  ()))
  "Face used for self-evaluating forms when `quack-fontify-style' is `plt'."
  :group 'quack)

(defconst quack-pltish-paren-face 'quack-pltish-paren-face)
(defface  quack-pltish-paren-face
  '((((class color) (background light)) (:foreground "red3"))
    (((class color) (background dark))  (:foreground "red1"))
    (((class grayscale))                (:foreground "gray"))
    (t                                  ()))
  "Face used for parentheses when `quack-fontify-style' is `plt'."
  :group 'quack)

(defconst quack-pltish-colon-keyword-face 'quack-pltish-colon-keyword-face)
(defface  quack-pltish-colon-keyword-face
  '((t (:bold t :foreground "gray50")))
  "Face used for `#:' keywords when `quack-fontify-style' is `plt'.
Note that this isn't based on anything in PLT."
  :group 'quack)

(defconst quack-pltish-paren-face 'quack-pltish-paren-face)
(defface  quack-pltish-paren-face
  '((((class color) (background light)) (:foreground "red3"))
    (((class color) (background dark))  (:foreground "red1"))
    (((class grayscale))                (:foreground "gray"))
    (t                                  ()))
  "Face used for parentheses when `quack-fontify-style' is `plt'."
  :group 'quack)

(defconst quack-banner-face 'quack-banner-face)
(defface  quack-banner-face
  '((t (:family "Helvetica")))
  "Face used in the inferior process buffer for the MzScheme banner.

Currently only takes effect when `quack-fontify-style' is `plt'."
  :group 'quack)

(defconst quack-pltish-defn-face 'quack-pltish-defn-face)
(defface  quack-pltish-defn-face
  '((((class color) (background light)) (:bold t :foreground "blue3"))
    (((class color) (background dark))  (:bold t :foreground "blue1"))
    (t                                  (:bold t :underline t)))
  "Face used for names in toplevel definitions.

For PLT-style when `quack-pltish-fontify-definition-names-p' is non-nil."
  :group 'quack)

(defconst quack-pltish-class-defn-face 'quack-pltish-class-defn-face)
(defface  quack-pltish-class-defn-face
  '((((class color) (background light))
     (:foreground "purple3" :inherit quack-pltish-defn-face))
    (((class color) (background dark))
     (:foreground "purple1" :inherit quack-pltish-defn-face))
    (t (:inherit quack-pltish-defn-face)))
  "Face used for class names in toplevel definitions.

For PLT-style when `quack-pltish-fontify-definition-names-p' is non-nil."
  :group 'quack)

(defconst quack-pltish-module-defn-face 'quack-pltish-module-defn-face)
(defface  quack-pltish-module-defn-face
  '((((class color) (background light))
     (:foreground "purple3" :inherit quack-pltish-defn-face))
    (((class color) (background dark))
     (:foreground "purple1" :inherit quack-pltish-defn-face))
    (t (:inherit quack-pltish-defn-face)))
  "Face used for module names in toplevel definitions.

For PLT-style when `quack-pltish-fontify-definition-names-p' is non-nil."
  :group 'quack)

(defconst quack-pltish-keyword-face 'quack-pltish-keyword-face)
(defface  quack-pltish-keyword-face
  '((t (:bold t)))
  "Face used for keywords in PLT Style fontification.

For PLT-style when `quack-pltish-fontify-keywords-p' is non-nil."
  :group 'quack)

(defconst quack-threesemi-semi-face 'quack-threesemi-semi-face)
(defface  quack-threesemi-semi-face
  '((((class color) (background light))
     (:foreground "#a0ffff":background "#c0ffff"))
    (((class color) (background dark))
     (:foreground "cyan2" :background "cyan4"))
    (t (:slant italic)))
  "Face used for `;;;' semicolons when `quack-fontify-threesemi-p' is non-nil."
  :group 'quack)

(defconst quack-threesemi-text-face 'quack-threesemi-text-face)
(defface  quack-threesemi-text-face
  '((((class color) (background light))
     (:foreground "cyan4" :background "#c0ffff"))
    (((class color) (background dark))
     (:foreground "white" :background "cyan4"))
    (t (:slant italic)))
  "Face used for `;;;' text when `quack-fontify-threesemi-p' is non-nil."
  :group 'quack)

(defconst quack-threesemi-h1-face 'quack-threesemi-h1-face)
(defface  quack-threesemi-h1-face
  '((t (:bold t :family "Helvetica" :height 1.4 :size "20pt")))
  "Face used for H1 headings in `;;;' text."
  :group 'quack)

(defconst quack-threesemi-h2-face 'quack-threesemi-h2-face)
(defface  quack-threesemi-h2-face
  '((t (:bold t :family "Helvetica" :height 1.2 :size "16pt")))
  "Face used for H2 headings in `;;;' text."
  :group 'quack)

(defconst quack-threesemi-h3-face 'quack-threesemi-h3-face)
(defface  quack-threesemi-h3-face
  '((t (:bold t :family "Helvetica")))
  "Face used for H3 headings in `;;;' text."
  :group 'quack)

(defconst quack-pltfile-prologue-face 'quack-pltfile-prologue-face)
(defface  quack-pltfile-prologue-face
  '((((class color))     (:foreground "black" :background "gray66"))
    (((class grayscale)) (:foreground "black" :background "gray66"))
    (t                   ()))
  "Face used for the prologue in a decoded PLT package buffer."
  :group 'quack)

(defconst quack-pltfile-dir-face 'quack-pltfile-dir-face)
(defface  quack-pltfile-dir-face
  '((((class color))     (:bold t :foreground "white" :background "gray33"
                                :family "Helvetica" :height 1.2 :size "20pt"))
    (((class grayscale)) (:bold t :foreground "white" :background "gray33"
                                :family "Helvetica" :height 1.2 :size "20pt"))
    (t                   (:bold t :inverse-video t)))
  "Face used for directory headers in a decoded PLT package buffer."
  :group 'quack)

(defconst quack-pltfile-file-face 'quack-pltfile-file-face)
(defface  quack-pltfile-file-face
  '((((class color))     (:bold t :foreground "black" :background "gray66"
                                :family "Helvetica" :height 1.2 :size "20pt"))
    (((class grayscale)) (:bold t :foreground "black" :background "gray66"
                                :family "Helvetica" :height 1.2 :size "20pt"))
    (t                   (:bold t :inverse-video t)))
  "Face used for file headers in a decoded PLT package buffer."
  :group 'quack)

(defconst quack-about-title-face 'quack-about-title-face)
(defface  quack-about-title-face
  '((((class color) (background light))
     (:bold t :family "Helvetica" :foreground "#008000"
            :height 2.0 :size "24pt"))
    (((class color) (background dark))
     (:bold t :family "Helvetica" :foreground "#00f000"
            :height 2.0 :size "24pt"))
    (t               (:bold t :family "Helvetica"
                            :height 2.0 :size "24pt")))
  "Face used for Quack name in About Quack."
  :group 'quack)

(defconst quack-about-face 'quack-about-face)
(defface  quack-about-face
  '((t (:family "Helvetica")))
  "Face used for the body text in About Quack."
  :group 'quack)

(defconst quack-smallprint-face 'quack-smallprint-face)
(defface  quack-smallprint-face
  '((t (:family "Courier" :height 0.8 :size "8pt")))
  "Face used for the \"small print\" in About Quack."
  :group 'quack)

;; Compatibility/Portability Misc. Kludges:

;; Note: Some compatibility gotchas found while porting Quack that aren't
;; addressed by macros and functions:
;;
;;   * `defface' in Emacs 21 supports ":weight bold", but this is silently
;;     ignored under older Emacsen, so ":bold t" must be used instead.
;;
;;   * Third argument of `detect-coding-region' is different in Emacs 21 and
;;     XEmacs 21, so only use the first two args.
;;
;;   * Under XEmacs 21, characters are `equal' but not `eq' to their integer
;;     ASCII values
;;
;;   * GNU Emacs 21 faces have `:height' property that is either absolute
;;     decipoints or relative scaling factor.  XEmacs 21 faces instead have
;;     `:size' property, which appears to be absolute point or mm size.
;;
;;   * XEmacs 21 text properties appear to be front-sticky, and there did not
;;     seem to be any documentation references to stickiness.
;;
;;   * XEmacs 21 `local-variable-p' has second argument mandatory.
;;
;;   * XEmacs 21 does not display submenu labels at all unless the submenu has
;;     content.  For inactive submenus, an empty string suffices for content.
;;
;;   * XEmacs 21 doesn't support composite characters (which we use for very
;;     nice pretty lambda under GNU Emacs).

(eval-and-compile
  (defvar quack-xemacs-p (eval '(and (boundp 'running-xemacs) running-xemacs)))
  (defvar quack-gnuemacs-p (not quack-xemacs-p)))

(defmacro quack-when-xemacs (&rest args)
  (if quack-xemacs-p (cons 'progn args) 'nil))

(defmacro quack-when-gnuemacs (&rest args)
  (if quack-gnuemacs-p (cons 'progn args) 'nil))

(defmacro quack-define-key-after (keymap key definition &optional after)
  (if quack-gnuemacs-p
      `(define-key-after ,keymap ,key ,definition ,after)
    `(define-key ,keymap ,key (prog1 ,definition ,after))))

(defmacro quack-delete-horizontal-space (&rest args)
  (if (and quack-gnuemacs-p (>= emacs-major-version 21))
      `(delete-horizontal-space ,@args)
    `(delete-horizontal-space)))

(defmacro quack-match-string-no-properties (&rest args)
  `(,(if quack-xemacs-p 'match-string 'match-string-no-properties) ,@args))

(defmacro quack-menufilter-return (name form)
  (if (= emacs-major-version 20)
      ;; Note: This isn't working in Emacs 20.  Menu displays now but actions
      ;;       are not executed.  No answer to test case posted to comp.emacs
      ;;       and then to gnu.emacs.help.  In response to my subsequent bug
      ;;       report against Emacs, RMS says that, if this is indeed a bug,
      ;;       then nothing will be done, since 20 is no longer supported.  I'm
      ;;       going to let this quietly not work unless someone emails me that
      ;;       they're actually using Emacs 20.
      `(easy-menu-filter-return (easy-menu-create-menu ,name ,form))
    form))

(defmacro quack-propertize (obj &rest props)
  (if (and quack-gnuemacs-p (>= emacs-major-version 21))
      `(propertize ,obj ,@props)
    (let ((obj-var 'quack-propertize-G-obj))
      `(let ((,obj-var ,obj))
         (add-text-properties 0 (length ,obj-var) (list ,@props) ,obj-var)
         ,obj-var))))

(eval-when-compile
  (when quack-xemacs-p
    (defvar inhibit-eol-conversion)
    (defvar minibuffer-allow-text-properties)))

;; Compatibility/Portability Hash Table:

(eval-and-compile
  (defmacro quack-make-hash-table (&rest args)
    `(,(if (>= emacs-major-version 21)
           'make-hash-table
         'quack-fake-make-hash-table)
      ,@args)))

(defmacro quack-puthash (key value table)
  (list (if (>= emacs-major-version 21) 'puthash 'quack-fake-puthash)
        key value table))

(defmacro quack-gethash (key table &optional dflt)
  (list (if (>= emacs-major-version 21) 'gethash 'quack-fake-gethash)
        key table dflt))

(defun quack-fake-make-hash-table (&rest args)
  ;; TODO: Parse the keyword args and make this do 'assoc or 'assq, as
  ;;       appropriate.  Currently, this package only needs 'assoc.
  (vector 'assoc '()))

(defun quack-fake-puthash (key value table)
  (let ((pair (funcall (aref table 0) key (aref table 1))))
    (if pair
        (setcdr pair value)
      (aset table 1 (cons (cons key value) (aref table 1))))))

(defun quack-fake-gethash (key table &optional dflt)
  (let ((pair (funcall (aref table 0) key (aref table 1))))
    (if pair (cdr pair) dflt)))

;; Compatibility/Portability Overlays/Extents:

;; TODO: Maybe get rid of overlays (and the XEmacs extent kludge), and just use
;;       text properties instead.

(defmacro quack-make-face-ovlext (beg end face)
  (if quack-xemacs-p
      `(set-extent-property (make-extent ,beg ,end) 'face ,face)
    `(overlay-put (make-overlay ,beg ,end) 'face ,face)))

(defmacro quack-make-hiding-ovlext (beg end)
  (if quack-xemacs-p
      `(set-extent-property (make-extent ,beg ,end) 'invisible t)
    `(overlay-put (make-overlay ,beg ,end) 'category 'quack-hiding-ovlcat)))

;; Messages, Errors, Warnings:

(defmacro quack-activity (what &rest body)
  (let ((var-what (make-symbol "quack-activity-G-what")))
    `(let ((,var-what ,what))
       (message (concat ,var-what "..."))
       (prog1 (progn ,@body)
         (message (concat ,var-what "...done"))))))

(defun quack-internal-error (&optional format &rest args)
  (if format
      (apply 'error (concat "Quack Internal Error: " format) args)
    (error "Quack Internal Error.")))

(defun quack-warning (format &rest args)
  (apply 'message (concat "Quack Warning: " format) args)
  (unless quack-quiet-warnings-p
    (beep)
    (sleep-for 1)))

;; Regular Expressions:

(defun quack-re-alt (&rest regexps)
  (concat "\\(" (mapconcat 'identity regexps "\\|") "\\)"))

(defun quack-re-optional (&rest regexps)
  (concat "\\("
          (apply 'concat regexps)
          "\\)?"))

;; Misc.:

;; (defun quack-abbreviate-file-name (file-name)
;;   (let ((directory-abbrev-alist '()))
;;     (abbreviate-file-name file-name)))

(defun quack-delete-file-if-can (file)
  (condition-case nil (delete-file file) (error nil)))

(defun quack-expand-file-name (name-or-names &optional directory)
  ;; Note: This only works for systems with Unix-like filenames.
  (expand-file-name (if (listp name-or-names)
                        (mapconcat 'identity name-or-names "/")
                      name-or-names)
                    directory))

(defun quack-kill-current-buffer ()
  (interactive)
  (kill-buffer (current-buffer)))

(defun quack-line-at-point ()
  (save-excursion
    (buffer-substring-no-properties
     (progn (beginning-of-line) (point))
     (progn (end-of-line)       (point)))))

(defun quack-looking-at-backward (re &optional limit)
  (save-excursion
    (save-restriction
      (let ((start-pt (point)))
        (narrow-to-region (point-min) (point))
        (and (re-search-backward re limit t)
             (= (match-end 0) start-pt)
             (match-beginning 0))))))

(defun quack-looking-at-close-paren-backward ()
  (save-match-data
    (quack-looking-at-backward "[])][ \t\r\n\f]*")))

(defun quack-looking-at-open-paren-backward ()
  (save-match-data
    (quack-looking-at-backward "[[(][ \t\r\n\f]*")))

(defun quack-make-directory (dir)
  (setq dir (file-name-as-directory dir))
  (unless (file-directory-p dir)
    (make-directory dir t)))

(defun quack-make-directory-for-file (file)
  (let ((dir (file-name-directory file)))
    (when dir (quack-make-directory dir))))

(defun quack-propertize-bold (str)
  (quack-propertize str 'face 'bold))

(defun quack-propertize-face (str face)
  (quack-propertize str 'face face))

(defun quack-propertize-italic (str)
  (quack-propertize str 'face 'italic))

(defun quack-sort-string-list-copy (lst)
  (sort (copy-sequence lst) 'string<))

(defun quack-uncomment-region (beg end)
  ;; TODO: Make a quack-toggle-commentout-region.
  (interactive "r")
  (comment-region beg end '(4)))

(defun quack-without-side-whitespace (str)
  ;; Copied from `padr-str-trim-ws' by author.
  ;;
  ;; TODO: Don't make an intermediate string.  Use regexp match start position.
  (save-match-data
    (if (string-match "^[ \t\n\r]+" str)
        (setq str (substring str (match-end 0))))
    (if (string-match "[ \t\n\r]+$" str)
        (setq str (substring str 0 (match-beginning 0))))
    str))

;; Kludgey Sexp Buffer Operations:

(defconst quack-backward-sexp-re
  (concat "\\`"
          (quack-re-alt "[^\";\\\\]"
                        "\\\\\\."
                        (concat "\""
                                (quack-re-alt "[^\"\\\\]"
                                              "\\\\\\.")
                                "*\""))
          "*\\([\"\\\\]\\)?"))

(defun quack-backward-sexp ()
  ;; Returns non-nil iff point was in a string literal or comment.
  (interactive)
  (when (bobp)
    (error "beginning of buffer"))
  (save-match-data
    (let* ((orig (point))
           (bol  (progn (beginning-of-line) (point))))
      (if (string-match quack-backward-sexp-re
                        (buffer-substring-no-properties bol orig))
          (if (match-beginning 3)
              ;; We're in what appears to be a comment or unterminated string
              ;; literal (though might not be, due to multi-line string
              ;; literals and block comments), so move point to the beginning.
              (progn (goto-char (+ bol (match-beginning 3)))
                     t)
            ;; We don't appear to be in a comment or string literal, so just
            ;; let `backward-sexp' do its thing.
            (goto-char orig)
            (backward-sexp)
            nil)))))

(defun quack-parent-sexp-search (name-regexp &optional max-depth max-breadth)
  (save-match-data
    (save-excursion
      (let ((max-depth   (or max-depth   100))
            (max-breadth (or max-breadth 100))
            (orig-point  (point))
            (found       'looking)
            (depth       0)
            (child-start nil))
        (while (and (eq found 'looking) (< depth max-depth))
          (condition-case nil
              (let ((breadth 0))
                ;; Loop until we hit max breadth or error.
                (while (< breadth max-breadth)
                  (when (and (quack-backward-sexp) (not child-start))
                    (setq child-start (point)))
                  (setq breadth (1+ breadth)))
                ;; We hit our max breadth without erroring, so set the found
                ;; flag to indicate failure and then fall out of our loop.
                (setq found nil))
            (error                      ; scan-error
             ;; We probably hit the beginning of the enclosing sexp, and point
             ;; should be on the first sexp, which will most often be the form
             ;; name, so first check that there really is an open paren to our
             ;; left, and then check if it matches our regexp.
             (let ((paren-start (quack-looking-at-open-paren-backward)))
               (if paren-start
                   ;; There is a paren, so check the name of the form.
                   (if (and (looking-at name-regexp)
                            (quack-not-symbol-char-at-point-p (match-end 0)))
                       ;; Found it, so set the result to a list (lexeme, lexeme
                       ;; end point, last nested child sexp start point, parent
                       ;; paren start point) and then fall out of our loop.
                       ;; Note that we return the original point if no child
                       ;; point was found, on the assumption that point was at
                       ;; the beginning of the child sexp (unless it was within
                       ;; the found form name, in which case child sexp start
                       ;; is nil).
                       (setq found (list (quack-match-string-no-properties 0)
                                         (match-end 0)
                                         (or child-start
                                             (if (> orig-point (match-end 0))
                                                 orig-point))
                                         paren-start))
                     ;; This form name didn't match, so try to move up in the
                     ;; paren syntax (which will usually mean moving left one
                     ;; character).
                     (condition-case nil
                         (progn (up-list -1)
                                (setq child-start (point))
                                (setq depth (1+ depth)))
                       (error           ; scan-error
                        ;; We can't go up here, so set found flag to indicate
                        ;; failure and then fall out of the loop.
                        (setq found nil))))
                 ;; There wasn't a paren, which means we hit a scan error for
                 ;; some reason other than being at the beginning of the sexp,
                 ;; so consider the search a failure
                 (setq found nil))))))
        (if (eq found 'looking)
            nil
          found)))))

;; TODO: We really need a global definition of what are Scheme symbol
;;       constituent characters (or a whole-symbol regexp)!

(defun quack-not-symbol-char-at-point-p (pt)
  ;; This is used to check for a symbol boundary point.
  (save-match-data
    (or (= pt (point-max))
        (if (string-match "[^-a-zA-Z0-9!+<=>$%&*./:@^_~]"
                          (buffer-substring-no-properties pt (1+ pt)))
            t))))

;; String Constant Hashtable:

(eval-and-compile
  (if (< emacs-major-version 21)

      (defun quack-strconst (str) str)

    (defvar quack-strconst-hashtable
      (if (>= emacs-major-version 21)
          (quack-make-hash-table :test 'equal :size 1000)))

    (defun quack-strconst (str)
      (unless (stringp str)
        (error "Non-string object passed to quack-strconst: %s" str))
      (or (quack-gethash str quack-strconst-hashtable nil)
          (quack-puthash str str quack-strconst-hashtable)
          str))))

;; Web URLs:

(defun quack-quote-url-substring (str &optional quote-slash-p always-new-p)
  (save-match-data
    (let ((regexp (if quote-slash-p "[^-_.A-Za-z0-9]" "[^-_.A-Za-z0-9/]"))
          (subs   '())
          (len    (length str))
          (start  0))
      (while (and (> len start)
                  (string-match regexp str start))
        (let ((beg (match-beginning 0))
              (end (match-end       0)))
          (when (> beg start)
            (setq subs (cons (substring str start beg) subs)))
          (setq subs (cons (format "%%%X" (aref str beg)) subs))
          (setq start end)))
      (if subs
          (apply 'concat (reverse (if (> len start)
                                      (cons (substring str start len) subs)
                                    subs)))
        (if always-new-p (copy-sequence str) str)))))

(defun quack-file-url (dir file)
  ;; TODO: This is Unix-centric and a little fragile.  Rewrite eventually.
  (concat "file:"
          (quack-quote-url-substring dir)
          "/"
          (or (quack-quote-url-substring file) "")))

(defun quack-build-url (base path)
  (let ((base-slash-p (= (aref base (1- (length base))) ?\/)))
    (if path
        (mapconcat 'identity
                   (cons (if base-slash-p
                             (substring base 0 -1)
                           base)
                         path)
                   "/")
      (if base-slash-p
          base
        (concat base "/")))))

;; Web Browsing:

(defun quack-browse-url (url)
  (require 'browse-url)
  (message "Quack viewing URL: %s" url)
  (let ((browse-url-browser-function (or quack-browse-url-browser-function
                                         browse-url-browser-function)))
    (browse-url url)))

(defun quack-browse-quack-web-page ()
  (interactive)
  (quack-browse-url quack-web-page))

(defun quack-w3m-browse-url-other-window (url &optional new-window)
  (interactive (eval '(browse-url-interactive-arg "URL: ")))
  (unless (string= (buffer-name) "*w3m*")
    (switch-to-buffer-other-window (current-buffer)))
  ;; TODO: If `*w3m*' buffer is visible in current frame or other frame,
  ;;       switch to that, for Emacsen that don't do that by default.
  (eval '(w3m-browse-url url nil)))

;; Web Getting:

(defconst quack-web-get-log-buffer-name "*quack-web-get*")

(defun quack-web-get-to-file (url out-file)
  ;; TODO: Support other getting tools, such as "lynx -source", "links
  ;;       -source", "w3m -dump_source", and the Emacs w3 package.  Most of
  ;;       these send the Web content to stdout, so, unlike for wget, it will
  ;;       be easier to insert directly to a buffer and send stderr to a temp
  ;;       file.  We should have *-to-file-* and *-insert-via-* functions for
  ;;       each external downloader program anyway.
  (quack-make-directory-for-file out-file)
  (quack-web-get-to-file-via-wget url out-file))

;;(defun quack-web-get-to-temp-file (url)
;;  (let ((temp-file (quack-make-temp-file "web-get")))
;;    (quack-web-get-to-file url temp-file)
;;    temp-file))

(defun quack-web-get-to-file-via-wget (url out-file)
  ;; TODO: Make this initially download to a temp file; replace any
  ;;       pre-existing out-file after successful download.  Do this for any
  ;;       external downloader programs that write to the specified output file
  ;;       before the download is complete.
  (let ((window    (selected-window))
        (saved-buf (current-buffer))
        (log-buf   (get-buffer-create quack-web-get-log-buffer-name)))
    (unwind-protect
        (progn
          ;; Prepare the log buffer.
          (set-buffer log-buf)
          (widen)
          (buffer-disable-undo)
          (goto-char (point-min))
          (delete-region (point-min) (point-max))
          (set-window-buffer window log-buf)
          ;; Do the wget.
          (quack-activity
           (format "Getting %S via wget" url)
           (let ((status (call-process "wget" nil t t
                                       "-O" out-file "-t" "1" "--" url)))
             (unless (= status 0)
               (quack-delete-file-if-can out-file)
               (error "Could not get %S via wget." url))
             (kill-buffer log-buf)
             out-file)))
      ;; unwind-protect cleanup
      (set-window-buffer window saved-buf)
      (set-buffer saved-buf))))

;; HTML Kludges:

(defun quack-strip-limited-html-tags (str)
  (save-match-data
    (let ((case-fold-search t)
          (str-len          (length str))
          (frags            '())
          (start            0))
      (while (string-match "" str start)
        (when (> (match-beginning 0) start)
          (setq frags (cons (substring str start (match-beginning 0)) frags)))
        (setq start (match-end 0)))
      (if frags
          (progn (when (< start str-len)
                   (setq frags (cons (substring str start) frags)))
                 (apply 'concat (reverse frags)))
        str))))

;; Temp Files:

(defun quack-temp-dir ()
  (file-name-as-directory (expand-file-name "tmp" quack-dir)))

;; TODO: Make sure this gets executed in load phase even if byte-compiled.

(random t)

(defun quack-make-temp-file (purpose-str)
  ;; Note: There is an obvious race condition here.  But we're trying to do
  ;;       this in portable Elisp, and if user's `quack-dir' is writable by
  ;;       someone other than user, then user has bigger problems.
  (save-excursion
    (let* ((buf (generate-new-buffer "*quack-make-temp-file*"))
           (dir (quack-temp-dir))
           file)
      (set-buffer buf)
      (quack-make-directory dir)
      (while (progn (setq file (expand-file-name (format "%d-%s-%d"
                                                         (emacs-pid)
                                                         purpose-str
                                                         (random 10000))
                                                 dir))
                    (file-exists-p file)))
      (set-visited-file-name file)
      (save-buffer 0)
      (kill-buffer buf)
      file)))

;; About:

(defun quack-about ()
  (interactive)
  (let* ((buf-name "*About Quack*")
         (buf      (get-buffer buf-name)))
    (when buf (kill-buffer buf))
    (setq buf (get-buffer-create buf-name))
    (switch-to-buffer buf)
    (setq buffer-read-only nil)
    (widen)
    (fundamental-mode)
    (when font-lock-mode
      ;;(quack-warning "Font-lock mode mysteriously on in fundamental-mode.")
      (font-lock-mode -1))
    (buffer-disable-undo)
    ;;(delete-region (point-min) (point-max))
    (erase-buffer)
    (insert
     "\n"
     (quack-propertize-face (copy-sequence "Quack") 'quack-about-title-face)
     "   Version "
     (quack-propertize-bold (copy-sequence quack-version))
     "\n"
     (quack-propertize-italic
      (copy-sequence "Enhanced Emacs support for Scheme programming"))
     "\n\n"
     "You can email bug reports and feature requests to the author,\n"
     quack-author-name
     " <"
     quack-author-email
     ">.  Mention that\n"
     "you are using "
     (quack-propertize-bold
      (copy-sequence
       (cond (quack-gnuemacs-p "GNU Emacs")
             (quack-xemacs-p   "XEmacs")
             (t                "*an unrecognized Emacs kind*"))))
     " "
     (quack-propertize-bold
      (format "%d.%d" emacs-major-version emacs-minor-version))
     " on "
     (quack-propertize-bold (copy-sequence system-configuration))
     ".\n\n"
     "To be notified via email when new Quack versions are released,\n"
     "ask Neil to add you to the moderated "
     (quack-propertize-bold "scheme-announce")
     " list.\n\n"
     "Visit the Web page:  "
     quack-web-page
     "\n")
    (insert "\n\n"
            (quack-propertize-face (copy-sequence quack-copyright)
                                   'quack-smallprint-face)
            "\n"
            (quack-propertize-face (copy-sequence quack-copyright-2)
                                   'quack-smallprint-face)
            "\n\n"
            (quack-propertize-face (concat quack-legal-notice "\n")
                                   'quack-smallprint-face))
    (goto-char (point-min))
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)
    (local-set-key "q" 'quack-kill-current-buffer)
    (local-set-key "w" 'quack-browse-quack-web-page)
    (message
     "Press `q' to quit *About Quack*, `w' to visit the Quack Web page.")))

;; PLT Collections:

(defvar quack-pltcollects-alist-cache nil)

(defun quack-invalidate-pltcollects-caches ()
  (setq quack-pltcollects-alist-cache nil)
  (quack-invalidate-manuals-caches))

(defun quack-pltcollects-alist ()
  (or quack-pltcollects-alist-cache
      (quack-activity
       "Scanning PLT collection directories"
       (let ((result '()))
         (mapcar (function
                  (lambda (dir)
                    (mapcar (function
                             (lambda (subdir)
                               (unless (member subdir '("." ".." "CVS" "RCS"))
                                 (let ((subdir-path (expand-file-name subdir
                                                                      dir)))
                                   (when (file-directory-p subdir-path)
                                     (setq result
                                           (cons (cons subdir subdir-path)
                                                 result)))))))
                            (condition-case nil
                                (directory-files dir)
                              (file-error nil)))))
                 quack-pltcollect-dirs)
         (setq quack-pltcollects-alist-cache (reverse result))))))

(defun quack-dir-for-pltcollect (name)
  (cdr (assoc name (quack-pltcollects-alist))))

(defun quack-dired-pltcollect ()
  (interactive)
  (let* ((alist   (quack-pltcollects-alist))
         (default (if (assoc "mzlib" alist) "mzlib" nil))
         (dir (cdr (assoc
                    (completing-read
                     (if default 
                         (format "Dired for PLT collection (default %S): "
                                 default)
                       "Dired for PLT collection: ")
                     alist nil t nil nil default)
                    alist))))
    (and dir (dired dir))))

;; Find File:

(defun quack-shorter-file-relative-name (filename &optional directory)
  (let ((absolute (expand-file-name   filename directory))
        (relative (file-relative-name filename directory)))
    (if (< (length relative) (length absolute))
        relative
      absolute)))

;; TODO: Also write `quack-find-file-other-window' and
;;       `quack-find-file-other-frame' and steal appropriate key bindings.

(defun quack-find-file ()
  ;; TODO: Hangup/delay problems in mega-huge files.
  ;;
  ;; TODO: Handle `(load )'
  (interactive)
  (let* ((default (quack-find-file-default))
         (entry   (let ((insert-default-directory (if default
                                                      nil
                                                    insert-default-directory)))
                    (read-file-name
                     (if default
                         (format "Quack find file (default %S): "
                                 (quack-shorter-file-relative-name
                                  default
                                  default-directory))
                       "Quack find file: ")
                     default-directory
                     default))))
    (find-file (if (string= entry "")
                   (or default "")
                 entry))))

(defun quack-find-file-default ()
  (or (quack-pltrequire-at-point-filename)
      ;; TODO: Add support for syntax from Guile, SLIB, Chicken, etc.
      ))

;; TODO: Guile `:use-module' support.  Forget about 1.4, and do 1.6.
;;
;; (defun quack-guilecolonusemodule-at-point-data ()
;;   (save-match-data
;;     (when (thing-at-point-looking-at
;;            ":use-module[ \t]+\\(([^][()\"#'`,]+)\\)")
;;       (condition-case nil
;;           (car (read-from-string (buffer-substring-no-properties
;;                                   (match-beginning 1) (match-end 1))))
;;         (error nil)))))
;;
;; ;; (define-module (ice-9 expect) :use-module (ice-9 regex))

;; TODO: Guile 1.6 `use-modules' and `use-syntax' support.
;;
;; (use-modules (ice-9 regex))
;;
;; (use-modules ((ice-9 popen)
;;               :select  ((open-pipe . pipe-open) close-pipe)
;;               :renamer (symbol-prefix-proc 'unixy:)))
;;
;; (use-modules { SPEC }+ )
;;
;; SPEC ::= MODULE-NAME | (MODULE-NAME [:select SELECTION] [:renamer RENAMER])
;;
;; (use-syntax MODULE-NAME)

;; TODO: Support SLIB-style `require' forms:
;;
;; (require 'foo)

;; TODO: Bigloo `import' and maybe `extern' support.
;;
;; ;; /usr/share/doc/bigloo-examples/examples/Foreign/
;; (module example
;;   (import (bis foreign2 "foreign2.scm"))
;;   ...)
;;
;; ;; /usr/share/doc/bigloo-examples/examples/Fork/
;; (module sys-example
;;   (extern (include "sys/types.h")
;;           (include "wait.h")
;;           (include "unistd.h")
;;           ...))

;; TODO: PLT module language syntax: (module info (lib "infotab.ss" "setup")

(defconst quack-pltrequire-at-point-data-re
  (quack-re-alt "dynamic-require"
                (concat "require"
                        (quack-re-alt "-for-syntax"
                                      ""))))

(defconst quack-pltrequire-at-point-data-1-re
  (concat quack-pltrequire-at-point-data-re
          "\\>"))

(defconst quack-pltrequire-at-point-data-2-re
  (concat "[^\r\n]*[[(]"
          quack-pltrequire-at-point-data-re
          "[ \t]+\\([^\r\n]+\\)"))

(defun quack-pltrequire-at-point-data-1 ()
  (save-match-data
    (let ((qpss (quack-parent-sexp-search quack-pltrequire-at-point-data-1-re
                                          4)))
      (when qpss
        (let ((child-start (nth 2 qpss)))
          (when child-start
            (save-excursion
              (goto-char child-start)
              (condition-case nil
                  ;; Note: It is normally OK to use the Elisp reader here.
                  (read (current-buffer))
                (error nil)))))))))

(defun quack-pltrequire-at-point-data-2 ()
  (save-match-data
    (when (thing-at-point-looking-at quack-pltrequire-at-point-data-2-re)
      (let* ((read-start (match-beginning 2))
             (parts-pt   (- (point) read-start))
             (parts      (buffer-substring-no-properties read-start
                                                         (match-end 2)))
             (parts-len  (length parts))
             (start      0)
             (result     '()))
        (condition-case nil
            (while (< start parts-len)
              ;; Note: It is normally OK to use the Elisp reader here.
              (let ((r (read-from-string parts start)))
                (when (or (not result) (> parts-pt start))
                  (setq result (car r)))
                (setq start (cdr r))))
          (error nil))
        result))))

(defun quack-pltrequire-at-point-filename (&optional silent)
  (let* ((d (or (quack-pltrequire-at-point-data-1)
                (quack-pltrequire-at-point-data-2)))
         (m (cond
             ((not     d) nil)
             ((stringp d) d)
             ((listp   d)
              (let ((f (car d)))
                (when (symbolp f)
                  (cond ((memq f '(file lib))                 d)
                        ((memq f '(all-except rename))        (nth 1 d))
                        ((memq f '(prefix prefix-all-except)) (nth 2 d)))))))))
    (cond
     ((stringp m) m)
     ((listp   m)
      (let ((f (car m)))
        (when (symbolp f)
          (cond ((eq f 'file) (nth 1 f))
                ((eq f 'lib)
                 (let* ((file        (nth 1 m))
                        (collect     (or (nth 2 m) "mzlib"))
                        (collect-dir (quack-dir-for-pltcollect collect))
                        (subs        (nthcdr 3 m)))
                   (when file
                     (if collect-dir
                         (quack-expand-file-name (nconc subs (list file))
                                                 collect-dir)
                       (unless silent
                         (quack-warning "Cannot find collection %S" collect))
                       nil)))))))))))

;; Indenting Newline:

(defun quack-newline (&optional arg)
  (interactive "*P")
  (if (eq quack-newline-behavior 'newline)
      (newline arg)
    (if (eq quack-newline-behavior 'indent-newline-indent)
        (lisp-indent-line)
      (unless (eq quack-newline-behavior 'newline-indent)
        (error "invalid quack-newline-behavior value: %s"
               quack-newline-behavior)))
    (let ((n (prefix-numeric-value arg)))
      (when (> n 0)
        (while (> n 0)
          (setq n (1- n))
          (quack-delete-horizontal-space t)
          (newline))
        (lisp-indent-line)))))

;; Agreeing-Paren Insert:

;; TODO: Make paren-matching within comments limit seaching to within comments,
;;       not skip back and try to match code.  One workaround is to prefix
;;       parents/brackets in comments with backslash.

(defun quack-insert-closing (prefix default-close other-open other-close)
  (insert default-close)
  (unless prefix
    (let ((open-pt (condition-case nil
                       (scan-sexps (point) -1)
                     (error (beep) nil))))
      (when open-pt
        (let ((open-char (aref (buffer-substring-no-properties
                                open-pt (1+ open-pt))
                               0)))
          (when (= open-char other-open)
            (delete-backward-char 1)
            (insert other-close))))))
  (when blink-paren-function (funcall blink-paren-function)))

(defun quack-insert-closing-paren (&optional prefix)
  (interactive "P")
  (quack-insert-closing prefix ?\) ?\[ ?\]))

(defun quack-insert-closing-bracket (&optional prefix)
  (interactive "P")
  (quack-insert-closing prefix ?\] ?\( ?\)))

;; Opening-Paren Insert:

(defun quack-insert-opening (prefix char)
  (insert (if (or prefix (not quack-smart-open-paren-p)) char ?\())
  (when blink-paren-function (funcall blink-paren-function)))

(defun quack-insert-opening-paren (&optional prefix)
  (interactive "P")
  (quack-insert-opening prefix ?\())

(defun quack-insert-opening-bracket (&optional prefix)
  (interactive "P")
  (quack-insert-opening prefix ?\[))

;; Definition Lambda Syntax Toggling:

(defconst quack-toggle-lambda-re-1
  (concat "define\\*?"
          (quack-re-alt "-for-syntax"
                        "-public"
                        "/override"
                        "/private"
                        "/public"
                        "")))

(defconst quack-toggle-lambda-re-2
  (let ((ws-opt      "[ \t\r\n\f]*")
        (symbol      "[^][() \t\r\n\f]+")
        (open-paren  "[[(]")
        (close-paren "[])]"))
    (concat ws-opt
            (quack-re-alt               ; #=1
             (concat "\\("              ; #<2 `NAME (lambda ('
                     "\\("              ; #<3 name
                     symbol
                     "\\)"              ; #>3
                     ws-opt
                     open-paren
                     ws-opt
                     "lambda"
                     ws-opt
                     open-paren
                     ws-opt
                     "\\)")
             (concat "\\("              ; #<4 `(NAME'
                     open-paren
                     ws-opt
                     "\\("              ; #<5 name
                     symbol
                     "\\)"              ; #>5
                     ws-opt
                     "\\)"))
            "\\("                       ; #<6 optional close paren
            close-paren
            "\\)?"                      ; #>6
            )))

(defun quack-toggle-lambda ()
  (interactive)
  (save-match-data
    (let ((found (quack-parent-sexp-search quack-toggle-lambda-re-1))
          last-paren-marker
          leave-point-marker)
      (unless found
        (error "Sorry, this does not appear to be a definition form."))
      (unwind-protect
          (let ((lexeme-end (nth 1 found))
                (define-beg (nth 3 found)))

            ;; Make the markers.
            (setq last-paren-marker  (make-marker))
            (setq leave-point-marker (point-marker))

            ;; Move to right after the define form keyword, and match the
            ;; pattern of the two possible syntaxes.  Error if no match.
            (goto-char lexeme-end)
            (unless (looking-at quack-toggle-lambda-re-2)
              (error "Sorry, we can't grok this definition syntax."))

            ;; Pattern matched, so find the closing paren of the define form.
            (let ((pt (condition-case nil
                          (scan-sexps define-beg 1)
                        (error          ; scan-error
                         nil))))
              (if pt
                  (set-marker last-paren-marker (1- pt))
                (quack-warning
                 "This definition form sexp is unclosed.  Consider undo.")))

            ;; Now act based on which syntax we saw.
            (cond

             ((match-beginning 2)
              ;; We saw the syntax `NAME (lambda ('.
              (let ((name (quack-match-string-no-properties 3)))
                (when (marker-position last-paren-marker)
                  (goto-char last-paren-marker)
                  (let ((victim-beg (quack-looking-at-close-paren-backward)))
                    (unless victim-beg
                      (error "This definition form should end with `))'."))
                    (delete-region victim-beg (point))))
                (goto-char lexeme-end)
                (delete-region lexeme-end (match-end 2))
                (insert " (" name (if (match-beginning 6) "" " "))))

             ((match-beginning 4)
              ;; We saw the syntax `(NAME'.
              (let ((name (quack-match-string-no-properties 5)))
                (when (marker-position last-paren-marker)
                  (goto-char last-paren-marker)
                  (insert ")"))
                (goto-char lexeme-end)
                (delete-region lexeme-end (match-end 4))
                (insert " " name "\n")
                (set-marker leave-point-marker (point))
                (insert "(lambda (")
                (set-marker-insertion-type leave-point-marker t)))

             (t (quack-internal-error)))

            ;; Reindent, which also takes care of font-lock updating of deleted
            ;; and inserted text.
            (indent-region define-beg
                           (or (marker-position last-paren-marker)
                               (max (marker-position leave-point-marker)
                                    (point)))
                           nil))

        ;; unwind-protect cleanup
        (goto-char (marker-position leave-point-marker))
        (set-marker leave-point-marker nil)))))

;; Buffer Tidying:

;; TODO: Maybe have an option to automatically tidy the buffer on save.  Make
;;       default off.  This can be slow for larger buffers on older computers,
;;       especially if font-lock is activated.  It can also annoy people who
;;       have a CM system full of improperly formatted files, or who like
;;       things like formfeed characters in their files.

(defun quack-delete-all-in-buffer (regexp &optional subexp)
  (unless subexp (setq subexp 0))
  ;; Note: This moves the point and changes the match data.
  (goto-char (point-min))
  (while (re-search-forward regexp nil t)
    (goto-char (match-end subexp))
    (delete-region (match-beginning subexp) (point))))

(defun quack-tidy-buffer ()

  ;; TODO: Make sure this works with odd eol conventions and the various
  ;;       codeset representations in various versions of Emacs.

  ;; TODO: Maybe detect DrScheme ASCII-art "big letters" and protect them from
  ;;       reindenting.

  "Tidy the formatting of the current Scheme buffer.

This reindents, converts tabs to spaces, removes trailing whitespace on lines,
removes formfeed characters, removes extraneous blank lines, and makes sure
the buffer ends with a newline.

This can conceivably corrupt multi-line string literals, but not in any way
they wouldn't be corrupted by Usenet, various mailers, typesetting for print,
etc.

This may also result in large diffs when the tidied file is commited back to a
version control or configuration management system.  Consider making a VC or CM
delta that consists only of changes made by `quack-tidy-buffer'."
  (interactive)
  (if (= (point-min) (point-max))
      (message "Buffer is empty; no tidying necessary.")
    (let ((marker      (point-marker))
          (fill-prefix nil))
      (unwind-protect
          (save-excursion
            (save-match-data
              (quack-activity
               "Tidying buffer"

               ;; Make sure last character is a newline.
               (unless (string= "\n" (buffer-substring-no-properties
                                      (1- (point-max))
                                      (point-max)))
                 (goto-char (point-max))
                 (insert "\n"))

               ;; Remove form-feed characters.
               (quack-delete-all-in-buffer "\f")

               ;; Reindent buffer (without inserting any new tabs).
               ;; Note: This is the time-consuming pass.
               (let ((saved-indent-tabs-mode indent-tabs-mode))
                 (unwind-protect
                     (progn (setq indent-tabs-mode nil)
                            (indent-region (point-min) (point-max) nil))
                   ;; unwind-protect cleanup
                   (setq indent-tabs-mode saved-indent-tabs-mode)))

               ;; Expand any remaining tabs.
               (untabify (point-min) (point-max))

               ;; Remove trailing whitespace on each line.
               (quack-delete-all-in-buffer "\\([ \t\r]+\\)\n" 1)

               ;; Remove blank lines from top.
               (goto-char (point-min))
               (when (looking-at "[ \t\r\n]+")
                 (delete-region (match-beginning 0) (match-end 0)))

               ;; Remove excess adjacent blank lines.
               (quack-delete-all-in-buffer "\n\n\\(\n+\\)" 1)

               ;; Remove blank lines from bottom.
               (goto-char (point-max))
               (when (quack-looking-at-backward
                      "\n\\(\n\\)"
                      (max (point-min) (- (point-max) 3)))
                 (delete-region (match-beginning 1) (match-end 1))))))

        ;; unwind-protect cleanup
        (goto-char (marker-position marker))
        (set-marker marker nil)))))

;; SRFIs:

;; TODO: Archive local copies of SRFIs?  Have to update them when modified, but
;;       without unnecessarily downloading from the master site.  This is
;;       doable with wget mirroring, but not with things like "lynx -source".

(defconst quack-srfi-subindex-kinds '(draft final withdrawn)
  "List of symbols representing the three possible states of an SRFI (`draft',
`final', and `withdrawn'), in order of increasing precedence (e.g., final
follows draft,since a final version supercedes a draft version).")

(defvar quack-srfi-completes-cache 'invalid)
(defvar quack-srfi-menu-cache      'invalid)

(defun quack-srfi-completes ()
  (when (eq quack-srfi-completes-cache 'invalid)
    (quack-process-srfi-subindex-files))
  quack-srfi-completes-cache)

(defun quack-srfi-menu (&optional noninteractive)
  (when (eq quack-srfi-menu-cache 'invalid)
    (quack-process-srfi-subindex-files noninteractive))
  quack-srfi-menu-cache)

(defun quack-srfi-master-url (path)
  (quack-build-url quack-srfi-master-base-url path))

(defun quack-srfi-subindex-master-url (kind)
  (quack-srfi-master-url (list (quack-srfi-subindex-basename kind))))

(defun quack-srfi-dir ()
  (file-name-as-directory (expand-file-name "srfi" quack-dir)))

(defun quack-srfi-subindex-file (kind)
  (expand-file-name (quack-srfi-subindex-basename kind) (quack-srfi-dir)))

(defun quack-srfi-subindex-basename (kind)
  (format "%S-srfis.html" kind))

(defun quack-invalidate-srfi-index-caches ()
  (setq quack-srfi-completes-cache 'invalid)
  (setq quack-srfi-menu-cache      'invalid))

(defun quack-update-srfi-index ()
  (interactive)
  (quack-activity
   "Updating SRFI index"
   (quack-download-srfi-subindex-files)))

(defun quack-download-srfi-subindex-files ()
  (quack-invalidate-srfi-index-caches)
  (mapcar (function
           (lambda (kind)
             (quack-activity
              (format "Downloading %s SRFI subindex" kind)
              (quack-web-get-to-file (quack-srfi-subindex-master-url kind)
                                     (quack-srfi-subindex-file       kind)))))
          quack-srfi-subindex-kinds))

(defun quack-download-srfi-subindex-files-if-missing ()
  (let ((missing '()))
    (mapcar (function
             (lambda (kind)
               (unless (file-exists-p (quack-srfi-subindex-file kind))
                 (setq missing (nconc missing (list kind))))))
            quack-srfi-subindex-kinds)
    (when (and missing
               (y-or-n-p "Some cached SRFI subindexes are missing. Update? "))
      (quack-update-srfi-index))))

(defun quack-process-srfi-subindex-files (&optional noninteractive)
  (let ((index      '())
        (completes  '())
        (menu       (mapcar (function (lambda (kind) (cons kind nil)))
                            quack-srfi-subindex-kinds)))

    ;; Invalidate dependent caches.
    (quack-invalidate-srfi-index-caches)

    ;; Give user a chance to download any missing cache files all at once,
    ;; instead of prompting individually later.
    (unless noninteractive
      (quack-download-srfi-subindex-files-if-missing))

    ;; Parse the index files, letting entries for successive states supercede.
    (mapcar (function
             (lambda (kind)
               (mapcar (function
                        (lambda (new)
                          (let (old)
                            (if (setq old (assq (car new) index))
                                (setcdr old (cdr new))
                              (setq index (cons new index))))))
                       (quack-parse-srfi-subindex-file kind noninteractive))))
            quack-srfi-subindex-kinds)

    ;; Sort the parse form in reverse order, since the cache-building functions
    ;; will reverse this.
    (setq index (sort index (function (lambda (a b) (>= (car a) (car b))))))

    ;; Build the completions and menu caches.
    (let ((fmt (concat "%"
                       (if index
                           (number-to-string
                            (length (number-to-string (car (car index)))))
                         "")
                       "d  %s")))
      (mapcar (function
               (lambda (n)
                 (let ((num      (nth 0 n))
                       (kind     (nth 1 n))
                       (title    (nth 2 n)))
                   (unless kind (quack-internal-error))
                   (setq completes
                         (cons (cons (if (eq kind 'final)
                                         (format "%d  %s" num title)
                                       (format "%d  [%s] %s" num kind title))
                                     num)
                               completes))
                   (let ((pair (or (assq kind menu)
                                   (quack-internal-error))))
                     (setcdr pair (cons `[,(format fmt num title)
                                          (quack-view-srfi ,num)]
                                        (cdr pair)))))))
              index))

    ;; Finish the menu.
    (mapcar (function (lambda (n)
                        (setcar n (cdr (assoc (car n)
                                              '((draft     . "Draft")
                                                (final     . "Final")
                                                (withdrawn . "Withdrawn")))))
                        ;; Add dummy content so that XEmacs 21 will display
                        ;; the submenu label.
                        (unless (cdr n)
                          (setcdr n (cons "(None)" nil)))))
            menu)
    (setq menu `(["Update SRFI Index" quack-update-srfi-index]
                 "---"
                 ,@menu
                 ["Other SRFI..." quack-view-srfi]))

    ;; Store the results.
    (setq quack-srfi-menu-cache      menu)
    (setq quack-srfi-completes-cache completes)))

(defun quack-parse-srfi-subindex-file (kind &optional noninteractive)
  (save-excursion
    (let ((file (quack-srfi-subindex-file kind)))
      (unless (file-exists-p file)
        (error "No SRFI index file %S" file))
      (let* ((buf                (get-file-buffer file))
             (already-visiting-p buf))
        (unless buf
          (setq buf (find-file-noselect file t t)))
        (unwind-protect
            (progn (set-buffer buf)
                   (quack-parse-srfi-subindex-buffer kind))
          ;; unwind-protect-cleanup
          (unless already-visiting-p
            (kill-buffer buf)))))))

(defconst quack-parse-srfi-index-buffer-re-1
  (concat
   "
  • SRFI[ \t]+"
   "\\([0-9]+\\)"                       ; #=1 srfi number
   ":?[ \t]*"
   "\\("                                ; #<2 srfi title
                                        ; #=3
   (quack-re-alt "[^\r\n<>]" "")
   "+"
   "\\)"))

(defun quack-parse-srfi-subindex-buffer (kind)
  (save-excursion
    (let ((case-fold-search t)
          (alist            '()))
      (goto-char (point-min))
      (while (re-search-forward quack-parse-srfi-index-buffer-re-1 nil t)
        (let ((number (string-to-number (quack-match-string-no-properties 1)))
              (title  (quack-without-side-whitespace
                       (quack-strip-limited-html-tags
                        (quack-match-string-no-properties 2)))))
          (setq alist (cons

                       ;;(cons number
                       ;;      (if (and kind (not (eq kind 'final)))
                       ;;          (format "[%s] %s" kind title)
                       ;;        title))
                       (list number kind title)

                       alist))))
      (setq alist (reverse alist)))))

(defun quack-srfi-num-url (num)
  (quack-srfi-master-url (list (format "srfi-%d"      num)
                               (format "srfi-%d.html" num))))

(defconst quack-srfi-num-at-point-re-1
  "srfi[-: \t]*\\([0-9]+\\)")

(defconst quack-srfi-num-at-point-re-2
  ;; Note: We can't have "[^\r\n]*" as a prefix, since it's too slow.
  (concat quack-srfi-num-at-point-re-1 "[^\r\n]*"))

(defun quack-srfi-num-at-point ()
  ;; TODO: Make this get the nearest SRFI number in all cases.
  (save-match-data
    (let ((case-fold-search t))
      (cond ((thing-at-point-looking-at quack-srfi-num-at-point-re-1)
             (string-to-number (quack-match-string-no-properties 1)))
            ((thing-at-point-looking-at "[0-9]+")
             (string-to-number (quack-match-string-no-properties 0)))
            ((thing-at-point-looking-at quack-srfi-num-at-point-re-2)
             (string-to-number (quack-match-string-no-properties 1)))
            ((let ((str (quack-line-at-point)))
               (when (string-match quack-srfi-num-at-point-re-1 str)
                 (string-to-number
                  (quack-match-string-no-properties 1 str)))))))))

(defun quack-view-srfi (num)
  (interactive (list (quack-srfi-num-prompt "View SRFI number")))
  (when num
    (unless (and (integerp num) (>= num 0))
      (error "Not a valid SRFI number: %S" num))
    (quack-browse-url (quack-srfi-num-url num))))

(defun quack-srfi-num-prompt (prompt)
  (let* ((completes (quack-srfi-completes))
         (default   (quack-srfi-num-at-point))
         (input     (quack-without-side-whitespace
                     (completing-read
                      (if default
                          (format "%s (default %d): " prompt default)
                        (concat prompt ": "))
                      completes)))
         v)
    (cond ((or (not input) (string= "" input)) default)
          ((setq v (assoc input completes))      (cdr v))
          ((and (setq v (condition-case nil
                            (string-to-number input)
                          (error nil)))
                (integerp v)
                (>= v 0))
           v)
          (t (error "Invalid SRFI number: %s" input)))))

;; Doc Keyword Value Object:

(defmacro quack-kw-get-syntax   (o) `(aref ,o 0))
(defmacro quack-kw-get-file     (o) `(aref ,o 1))
(defmacro quack-kw-get-fragment (o) `(aref ,o 2))

(defmacro quack-kw-set-syntax   (o v) `(aset ,o 0 ,v))
(defmacro quack-kw-set-file     (o v) `(aset ,o 1 ,v))
(defmacro quack-kw-set-fragment (o v) `(aset ,o 2 ,v))

;; Documentation Object:

;; TODO: Rework these document representations once we know the different kinds
;;       of documents with which we'll be dealing.

(defmacro quack-doc-get-type         (o) `(aref ,o 0))
(defmacro quack-doc-get-sym          (o) `(aref ,o 1))
(defmacro quack-doc-get-title        (o) `(aref ,o 2))
(defmacro quack-doc-get-loc          (o) `(aref ,o 3))
(defmacro quack-doc-get-kw-p         (o) `(aref ,o 4))
(defmacro quack-doc-get-start-url    (o) `(aref ,o 5))
(defmacro quack-doc-get-kw-base-url  (o) `(aref ,o 6))
(defmacro quack-doc-get-kw-file      (o) `(aref ,o 7))
(defmacro quack-doc-get-kw-hashtable (o) `(aref ,o 8))

(defmacro quack-doc-set-type         (o v) `(aset ,o 0 ,v))
(defmacro quack-doc-set-sym          (o v) `(aset ,o 1 ,v))
(defmacro quack-doc-set-title        (o v) `(aset ,o 2 ,v))
(defmacro quack-doc-set-loc          (o v) `(aset ,o 3 ,v))
(defmacro quack-doc-set-kw-p         (o v) `(aset ,o 4 ,v))
(defmacro quack-doc-set-start-url    (o v) `(aset ,o 5 ,v))
(defmacro quack-doc-set-kw-base-url  (o v) `(aset ,o 6 ,v))
(defmacro quack-doc-set-kw-file      (o v) `(aset ,o 7 ,v))
(defmacro quack-doc-set-kw-hashtable (o v) `(aset ,o 8 ,v))

(defun quack-manual-to-doc (manual)
  ;; Accepts a user's manual preference object of the list form:
  ;;
  ;;     (SYM TITLE LOC KW-P)
  ;;
  ;; and creates a manual doc object of the vector form:
  ;;
  ;;     [manual SYM TITLE LOC KW-P START-URL KW-BASE-URL KW-FILE KW-P
  ;;      KEYWORDS]
  ;;
  ;; KEYWORDS is not populated here -- keywords importing for a manual happens
  ;; the first time keyword searching is done for the manual."
  (let ((sym       (nth 0 manual))
        (title     (nth 1 manual))
        (loc       (nth 2 manual))
        (kw-p      (nth 3 manual))
        (start-url nil)
        (kw-file   nil)
        (kw-base   nil))
    (cond
     ;; If the location is a string, then handle manual as simple URL.
     ((stringp loc)
      (setq start-url loc)
      (when kw-p
        (quack-warning "Quack can only use keywords for PLT manuals.")
        (setq kw-p nil)))
     ;; If the location is a symbol, handle manual as special.
     ((symbolp loc)
      (cond
       ;; If the location is symbol `plt', handle manual as PLT bundled.
       ((eq loc 'plt)
        (let* ((plt-name (let ((s (symbol-name sym)))
                           (if (string-match "\\`plt-\\(.+\\)\\'" s)
                               (match-string 1 s)
                             s)))
               (web-base   (concat
                           "http://download.plt-scheme.org/doc/"
                           plt-name
                           "/"))
              (index-name "index.htm")
              (col-dirs   quack-pltcollect-dirs))
          ;; Search from the collection directories for keywords and index
          ;; files.  Note that we currently look for keywords files even if
          ;; `kw-p' is false since we want to allow the user to dynamically
          ;; enable and disable keywords searching for a particular manual
          ;; without us having to change `quack-docs'.
          (while (and col-dirs (not (and kw-file kw-base start-url)))
            (let ((dir (expand-file-name plt-name
                                         (expand-file-name "doc"
                                                           (car col-dirs)))))
              (setq col-dirs (cdr col-dirs))
              (when (file-directory-p dir)
                (let* ((k-f (expand-file-name "keywords" dir))
                       (i-f (expand-file-name index-name dir))
                       (i-r (file-readable-p i-f)))
                  (if (file-readable-p k-f)
                      ;; Keywords file.
                      (if i-r
                          ;; Keywords file and index file.  So, unless we
                          ;; already found a keywords base URL, set everything
                          ;; based on this directory.  Note that we override
                          ;; any existing start URL because we prefer to use
                          ;; the same manual version for both keywords and
                          ;; non-keywords access.
                          (unless kw-base
                            (setq kw-file   k-f)
                            (setq kw-base   (quack-file-url dir nil))
                            (setq start-url (quack-file-url dir index-name)))
                        ;; Keywords file, but no index file.  So, unless we
                        ;; already have a keywords file, set it to this one.
                        (unless kw-file
                          (setq kw-file k-f)))
                    ;; No keywords file.  So, if there is an index file, and we
                    ;; don't already have one, then use this one.
                    (when (and i-r (not start-url))
                      (setq start-url (quack-file-url dir index-name))))))))
          ;; If we didn't find a start URL, use the Web one.
          (unless start-url
            (setq start-url (concat web-base index-name)))
          ;; Do we have a keywords file?
          (if kw-file
              ;; We have a keywords file, so set the keywords base to the Web
              ;; if needed and desired.  Note that we never use the keywords
              ;; file from one directory with the HTML files from a different
              ;; directory, on the assumption that a local copy of HTML missing
              ;; a keywords file is suspect, and that the Web version is
              ;; therefore preferable.
              (when (or (eq quack-local-keywords-for-remote-manuals-p 'always)
                        (and (not kw-base)
                             quack-local-keywords-for-remote-manuals-p))
                (setq kw-base web-base))
            ;; We don't have a keywords file, so warn if the user wanted
            ;; keywords for this manual.
            (when kw-p
              (quack-warning "Could not find keywords file for manual %S."
                             plt-name)))))
       ;; The location is an unrecognized symbol, so just barf.
       (t (quack-internal-error))))
     ;; The location is something other than a string or symbol, so just barf.
     (t (quack-internal-error)))
    ;; We've populated all the variables for the location type, so return the
    ;; representation.
    (vector 'manual sym title loc kw-p start-url kw-base kw-file nil)))

(defun quack-doc-keyword-lookup (doc keyword)
  (let ((ht (or (quack-doc-get-kw-hashtable doc)
                (progn (quack-doc-import-keywords doc)
                       (quack-doc-get-kw-hashtable doc)))))
    (if ht
        (quack-gethash keyword ht nil)
      (quack-warning "No keywords for document \"%S\"."
                     (quack-doc-get-sym doc))
      nil)))

(defun quack-doc-import-keywords (doc)
  (if (eq (quack-doc-get-loc doc) 'plt)
      (quack-doc-import-plt-manual-keywords doc)
    (quack-internal-error)))

(defun quack-doc-import-plt-manual-keywords (doc)
  ;; Reads in the predetermined keywords file for PLT manual `doc' object,
  ;; populating the `kw-hashtable' field of the `doc' object.  The format of
  ;; each entry in the PLT keywords file is a list of 5 strings:
  ;;
  ;;     (KEYWORD SYNTAX FILE FRAGMENT SECTION)
  ;;
  ;; The hashtable is keyed on the KEYWORD string, for which the value is
  ;; usually a vector:
  ;;
  ;;     [SYNTAX FILE-CONST FRAGMENT]
  ;;
  ;; where FILE-CONST is the FILE string registered with the `quack-strconst'
  ;; to save memory on redundant strings.
  ;;
  ;; When more there is more than one entry for a given keyword, then the value
  ;; of the hashtable entry for that keyword is a list of vectors, in the order
  ;; in which they were derived from the original keywords file.
  ;;
  ;; These duplicate values may be duplicated or conflicting, as in:
  ;;
  ;;     (["(regexp-match pattern input-port [start-k end-k output-port])"
  ;;       "mzscheme-Z-H-10.html" "%_kw_definitionregexp-match"]
  ;;      ["(regexp-match pattern string [start-k end-k output-port])"
  ;;       "mzscheme-Z-H-10.html" "%_kw_definitionregexp-match"])
  ;;
  ;; No attempt is made here to weed out any duplicate/conflicting entries --
  ;; that behavior left up to the code that accesses the hashtable.  For the
  ;; example above, a command to display the syntax for the keyword would need
  ;; to display both values.  However, a command to view the documentation for
  ;; the keyword would need only to display one Web page without querying the
  ;; user, since both entries above point to the same page and fragment.
  (quack-activity
   (format "Importing keywords for manual %S" (quack-doc-get-sym doc))
   (let (sexp)
     (garbage-collect)
     (condition-case err
         (setq sexp (quack-read-sexp-file
                     (or (quack-doc-get-kw-file doc)
                         (quack-warning "Manual %S has no keywords file."
                                        (quack-doc-get-sym doc)))))
       (error (quack-warning "Problem importing keywords for manual %S: %s"
                             (quack-doc-get-sym doc) err)))
     (when sexp
       (garbage-collect)
       (let ((ht (quack-make-hash-table :test             'equal
                                        :size             (length sexp)
                                        :rehash-threshold 1.0)))
         ;; Note: We make the hashtable equal to the length of the read list of
         ;; keyword forms so that it will be at least large enough for all the
         ;; keywords without being excessively overlarge, and without having to
         ;; do resizes or a counting pass or intermediate representation.  The
         ;; hashtable will be a little larger than necessary when there are
         ;; multiple keyword forms for the same keyword.  In a test with
         ;; MzScheme 200.2, the hashtable used/size for "mzscheme" manual was
         ;; 489/502; for "mzlib", 245/257.
         (quack-doc-set-kw-hashtable doc ht)
         (mapcar (function
                  (lambda (raw-entry)
                    (let* ((kw  (nth 0 raw-entry))
                           (new (vector (nth 1 raw-entry)
                                        (quack-strconst (nth 2 raw-entry))
                                        (nth 3 raw-entry)))
                           (old (quack-gethash kw ht nil)))
                      (quack-puthash
                       kw
                       (cond ((not     old) new)
                             ((vectorp old) (list  old new))
                             ((listp   old) (nconc old (list new))))
                       ht))))
                 sexp))))))

(defun quack-read-sexp-file (filename)
  (save-excursion
    (let* ((buf (generate-new-buffer "*quack-read-sexp-file*")))
      (set-buffer buf)
      (unwind-protect
          (progn (insert-file-contents-literally filename)
                 (goto-char (point-min))
                 (read buf))
        ;; unwind-protect cleanup
        (kill-buffer buf)))))

;; Documentation Database:

(defvar quack-docs 'invalid)

(defun quack-docs ()
  (when (eq quack-docs 'invalid)
    (quack-docs-build))
  quack-docs)

(defun quack-docs-build ()
  (quack-activity
   "Building Quack docs database"
   (quack-invalidate-manuals-caches)
   (setq quack-docs (mapcar 'quack-manual-to-doc quack-manuals))))

(defun quack-docs-manual-lookup (sym)
  (let ((docs  (quack-docs))
        (found nil))
    (while (and docs (not found))
      (let ((doc (car docs)))
        (setq docs (cdr docs))
        (when (eq (quack-doc-get-sym doc) sym)
          (setq found doc))))
    found))

(defun quack-docs-manual-keyword-lookup (keyword)
  (let ((results '()))
    (mapcar (function
             (lambda (doc)
               (cond
                ((not (quack-doc-get-kw-p doc)) nil)
                ((not (quack-doc-get-kw-base-url doc))
                 (quack-warning "Manual %S has no HTML."
                                (quack-doc-get-sym doc)))
                (t (let ((match (quack-doc-keyword-lookup doc keyword)))
                     (cond
                      ((not match) nil)
                      ((vectorp match)
                       (setq results (cons (cons doc match) results)))
                      ((listp match)
                       (mapcar (function
                                (lambda (m)
                                  (setq results (cons (cons doc m) results))))
                               match))
                      (t (quack-internal-error))))))))
            (quack-docs))
    (reverse results)))

;; Keyword Lookup Match Object:

(defmacro quack-kwmatch-get-doc (o) `(car ,o))
(defmacro quack-kwmatch-get-kw  (o) `(cdr ,o))

(defun quack-kwmatch-url (kwmatch)
  (let ((doc (car kwmatch))
        (kw  (cdr kwmatch)))
    (concat (quack-doc-get-kw-base-url doc)
            (quack-quote-url-substring (quack-kw-get-file kw))
            "#"
            (quack-quote-url-substring (quack-kw-get-fragment kw) t))))

;; Manual Viewing:

(defun quack-view-manual (&optional sym)
  "View a manual."
  (interactive
   (list
    (let* ((completes (or (quack-manuals-completes)
                          (error
                           "Sorry, variable \"quack-manuals\" is empty.")))
           (default   "R5RS")
           (input     (let ((completion-ignore-case t))
                        (completing-read
                         (format "Quack Manual (default %S): " default)
                         completes nil t nil nil default))))
      (cdr (or (assoc input completes)
               (error "No manual %S." input))))))
  (quack-activity
   (format "Viewing manual \"%S\"" sym)
   (quack-browse-url (or (quack-doc-get-start-url
                          (or (quack-docs-manual-lookup sym)
                              (error "Manual \"%S\" not found." sym)))
                         (error "Don't know a URL for manual \"%S\"." sym)))))

(defvar quack-manuals-menu-cache      'invalid)
(defvar quack-manuals-completes-cache 'invalid)

(defun quack-invalidate-manuals-caches ()
  (setq quack-docs                    'invalid)
  (setq quack-manuals-completes-cache 'invalid)
  (setq quack-manuals-menu-cache      'invalid))

;;(quack-invalidate-manuals-caches)

;; This version maps completion strings to URLs.
;; (defun quack-manuals-completes ()
;;   (when (eq quack-manuals-completes-cache 'invalid)
;;     (let ((completes '()))
;;       (mapcar (function
;;                (lambda (doc)
;;                  (let ((sym (quack-doc-get-sym doc))
;;                        (url (quack-doc-get-start-url doc)))
;;                    (setq completes
;;                          (cons (cons (quack-doc-get-title doc) url)
;;                                (cons (cons (symbol-name sym) url)
;;                                      completes))))))
;;               (quack-docs))
;;       (setq quack-manuals-completes-cache (reverse completes))))
;;   quack-manuals-completes-cache)

(defun quack-manuals-completes ()
  (when (eq quack-manuals-completes-cache 'invalid)
    (let ((completes '()))
      (mapcar (function
               (lambda (doc)
                 (let ((sym (quack-doc-get-sym doc))
                       ;;(url (quack-doc-get-start-url doc))
                       )
                   (setq completes
                         (cons (cons (quack-doc-get-title doc) sym)
                               ;;(cons (cons (symbol-name sym) sym)
                                     completes
                                     ;;)
                                     )))))
              (quack-docs))
      (setq quack-manuals-completes-cache (reverse completes))))
  quack-manuals-completes-cache)

(defun quack-manuals-menu ()
  (when (eq quack-manuals-menu-cache 'invalid)
    (setq quack-manuals-menu-cache
          (mapcar (function
                   (lambda (manual)
                     (let ((sym   (nth 0 manual))
                           (title (nth 1 manual)))
                       `[,title (quack-view-manual (quote ,sym))])))
                  quack-manuals)))
  quack-manuals-menu-cache)

(defun quack-manuals-webjump-sites ()
  "Returns `webjump' entries for manuals in `quack-manuals'.

Can be used in your `~/.emacs' file something like this:

    (require 'quack)
    (require 'webjump)
    (require 'webjump-plus)
    (setq webjump-sites
          (append my-own-manually-maintained-webjump-sites
                  (quack-manuals-webjump-sites)
                  webjump-plus-sites
                  webjump-sample-sites))"
  ;; TODO: Note what they should do if they are adding to plt collectsion dirs
  ;;       via custom settings but quack-manuals-webjump-sites is getting
  ;;       called before then.
  (let ((result                 '())
        (quack-quiet-warnings-p t))
    (mapcar (function
             (lambda (doc)
               (let ((url (quack-doc-get-start-url doc)))
                 (when url
                   (setq result (cons (cons (quack-doc-get-title doc) url)
                                      result))))))
            (quack-docs))
    result))

;; Keyword Docs Viewing:

;; TODO: Add doc lookup in PLT "doc.txt" files.  A little tricky.  Maybe make
;;       sure doc.txt is a long-term format first.

(defun quack-view-keyword-docs (keyword)
  ;; TODO: Don't prompt if all choices would result in the same URL.
  (interactive (list (quack-prompt-for-keyword "View docs for keyword")))
  (when (and keyword (stringp keyword) (not (string= keyword "")))
    (let ((matches (quack-docs-manual-keyword-lookup keyword)))
      (if (not matches)
          (message "Sorry, no documentation found for keyword %S." keyword)
        (quack-browse-url
         (quack-kwmatch-url
          (if (cdr matches)
              (quack-prompt-for-kwmatch-choice "Which" matches)
            (car matches))))))))

(defun quack-keyword-at-point ()
  ;; TODO: Make sure this reads all Scheme symbols -- it may currently only
  ;;       read valid Elisp symbols.
  (let ((bounds (bounds-of-thing-at-point 'symbol)))
    ;; In some cases (point at beginning of empty buffer?), `bounds' will be
    ;; the bounds of an empty string, so check this.
    (when bounds
      (let ((beg (car bounds))
            (end (cdr bounds)))
        (when (/= beg end)
          (buffer-substring-no-properties beg end))))))

(defun quack-prompt-for-keyword (prompt)
  (let* ((default (quack-keyword-at-point))
         (history (list default)))
    (read-string (if default
                     (format "%s (default %S): " prompt default)
                   (concat prompt ": "))
                 nil
                 ;; Note: Gratuitous reference to `history' eliminates warning
                 ;;       from XEmacs 21 byte-compiler.
                 (if (and default history) 'history nil)
                 default)))

(defun quack-prompt-for-kwmatch-choice (prompt kwmatch-list)
  (let ((completes '()))
    ;; Build the completion alist, ensure each key is unique.
    (mapcar
     (function
      (lambda (kwmatch)
        (let* ((kw         (quack-kwmatch-get-kw kwmatch))
               (orig-name  (or (quack-kw-get-syntax kw)
                               (progn (quack-warning "No keyword syntax: %s"
                                                     kw)
                                      "???")))
               (name       orig-name)
               (name-tries 1))
          ;; Ensure the name is unique within the completion list thus far.
          (while (assoc name completes)
            (setq name-tries (1+ name-tries))
            (setq name (format "%s #%d" orig-name name-tries)))
          ;; Prepend to the completion list (we'll reverse the list later).
          (setq completes (cons (cons name kwmatch) completes)))))
     kwmatch-list)
    (setq completes (reverse completes))
    ;; Prompt user and return selection.
    (let* ((default (car (car completes)))
           (read    (let ((completion-ignore-case t))
                      (completing-read
                       (format "%s (default %S): " prompt default)
                       completes nil t nil nil default))))
      (cdr (assoc read completes)))))

;; Inferior Process:

(defvar quack-run-scheme-prompt-history '())

(defun quack-remember-program-maybe (program)
  (when (and quack-remember-new-programs-p
             (not (member program quack-programs)))
    (quack-option-set 'quack-programs (cons program quack-programs) t)
    (message "Remembering program %S." program)))

(defun quack-run-scheme-prompt ()
  (let* ((last    (car quack-run-scheme-prompt-history))
         (default (or (and quack-run-scheme-prompt-defaults-to-last-p
                           last)
                      quack-default-program
                      scheme-program-name
                      last
                      "mzscheme"))
         (program (let ((minibuffer-allow-text-properties nil))
                    (completing-read
                     (concat "Run Scheme"
                             (if default
                                 (format " (default %S)" default)
                               "")
                             ": ")
                     (quack-run-scheme-prompt-completion-collection)
                     nil nil nil
                     'quack-run-scheme-prompt-history
                     default))))
    (quack-remember-program-maybe program)
    program))

(defun quack-run-scheme-prompt-completion-collection ()
  (let ((program-list quack-programs))
    (mapcar (function (lambda (program)
                        (and program
                             (not (member program program-list))
                             (setq program-list (cons program program-list)))))
            (list quack-default-program
                  scheme-program-name))
    (mapcar (function (lambda (program) (cons program nil)))
            program-list)))

(defadvice run-scheme (around quack-ad-run first nil activate)
  "Adds prompting for which Scheme interpreter program to run."
  ;; We don't want to prompt if there's already a Scheme running, but it's
  ;; possible for process to die between the comint check in `interactive' form
  ;; of this advice and the comint check in the `run-scheme' function.  We
  ;; should override `run-scheme' altogether, but for now let's only call the
  ;; original in the case that we do not detect a running Scheme.
  (interactive (list (cond ((comint-check-proc "*scheme*") nil)
                           ((or current-prefix-arg
                                quack-run-scheme-always-prompts-p)
                            (quack-run-scheme-prompt))
                           (t quack-default-program))))
  (if cmd
      ;; We will assume there is no running Scheme, so...  Since `run-scheme'
      ;; calls `pop-to-buffer' rather than `switch-to-scheme', our options for
      ;; Scheme process window management, such as putting the process buffer
      ;; window in its own frame, do not take effect when the process buffer is
      ;; displayed by `run-scheme'.  So, unless we are using the `cmuscheme'
      ;; window management behavior, we attempt to undo whatever window changes
      ;; and buffer changes `run-scheme' makes, then just call
      ;; `switch-to-scheme'.  (This code will be revisited once we decide how
      ;; to handle multiple Schemes, if not before then.)
      (let ((buf (current-buffer))
            (wg  (current-window-configuration)))
        ad-do-it
        (unless (or (not quack-switch-to-scheme-method)
                    (eq quack-switch-to-scheme-method 'cmuscheme))
          (set-window-configuration wg)
          (set-buffer buf)
          (switch-to-scheme t))
        (message "Started Scheme: %s" scheme-program-name))
    ;; There is a running Scheme, so don't call the `run-scheme' function at
    ;; all -- just call `switch-to-scheme' or duplicate the `cmuscheme'
    ;; package's `pop-to-buffer' behavior.
    (if (or (not quack-switch-to-scheme-method)
            (eq quack-switch-to-scheme-method 'cmuscheme))
        (pop-to-buffer "*scheme*")
      (switch-to-scheme t))
    (message "Switched to running Scheme: %s" scheme-program-name)))

(defadvice scheme-interactively-start-process (around
                                               quack-ad-sisp 
                                               first
                                               (&optional cmd)
                                               activate)
  ;; (save-window-excursion
  (call-interactively 'run-scheme)
  ;; )
  )

(defadvice scheme-proc (around quack-ad-scheme-proc first nil activate)
  (condition-case nil
      ad-do-it
    (error (message "Oops, we must start a Scheme process!")
           (call-interactively 'run-scheme)
           (setq ad-return-value (scheme-proc)))))

;; Switch-to-Scheme:

(defun quack-force-frame-switch-to-window (win)
  (let ((frame (window-frame win)))
    (unless (eq frame (selected-frame))
      (and window-system
           quack-warp-pointer-to-frame-p
           (set-mouse-position frame 0 0))
      (select-frame frame))
    (select-window win)))

(defadvice switch-to-scheme (before quack-ad-switch last nil activate)
  "Adds support for the `quack-switch-to-scheme-method' option."
  ;; This can be done as before-advice since the `pop-to-buffer' that
  ;; `switch-to-scheme' is using appears to always be a no-op when the target
  ;; buffer is already the current buffer.
  (require 'cmuscheme)
  ;; The `eval' below is to avoid problems with the byte-compiler and advising.
  ;; It doesn't seem to like: (and (boundp 'SYM) SYM)
  (let ((repl-buf (eval '(and (boundp 'scheme-buffer)
                              scheme-buffer
                              (get-buffer scheme-buffer)))))
    (cond ((not repl-buf)
           (error (concat "No process current buffer."
                          " Set `scheme-buffer' or execute `run-scheme'")))

          ((or (not quack-switch-to-scheme-method)
               (eq quack-switch-to-scheme-method 'cmuscheme))
           nil)

          ((eq (current-buffer) repl-buf) nil)

          ((eq quack-switch-to-scheme-method 'other-window)
           (switch-to-buffer-other-window repl-buf))

          ;; The following code may be revived if anyone reports problems with
          ;; the use of `special-display-popup-frame'.
          ;;
          ;; ((eq quack-switch-to-scheme-method 'own-frame)
          ;;  (let ((pop-up-frames                t)
          ;;        (same-window-buffer-names     nil)
          ;;        (same-window-regexps          nil)
          ;;        (special-display-buffer-names nil)
          ;;        (special-display-regexps      nil))
          ;;    (switch-to-buffer (pop-to-buffer repl-buf))))

          ((eq quack-switch-to-scheme-method 'own-frame)
           (quack-force-frame-switch-to-window
            (special-display-popup-frame repl-buf)))

          (t (error "Invalid quack-switch-to-scheme-method: %S"
                    quack-switch-to-scheme-method)))))

;; Customize:

(defun quack-customize ()
  "Customize the Quack package."
  (interactive)
  (customize-group 'quack))

;; Auto Modes:

(defun quack-add-auto-mode-alist (alist)
  (setq auto-mode-alist
        (append alist
                (let ((retained '()))
                  (mapcar (function (lambda (pair)
                                      (unless (assoc (car pair) alist)
                                        (setq retained (cons pair retained)))))
                          auto-mode-alist)
                  (reverse retained)))))

(quack-add-auto-mode-alist '(("\\.ccl\\'"    . scheme-mode)
                             ("\\.rkt\\'"    . scheme-mode)
                             ("\\.rktd\\'"   . scheme-mode)
                             ("\\.sch\\'"    . scheme-mode)
                             ("\\.scm\\'"    . scheme-mode)
                             ("\\.ss\\'"     . scheme-mode)
                             ("\\.stk\\'"    . scheme-mode)
                             ("\\.stklos\\'" . scheme-mode)
                             ;;
                             ("/\\.mzschemerc\\'" . scheme-mode)
                             ;; Non-Scheme:
                             ("\\.plt\\'"    . quack-pltfile-mode)))

;; Syntax Table:

(defmacro quack-str-syntax (str)
  `(,(if (and quack-gnuemacs-p (>= emacs-major-version 21))
         'string-to-syntax
       'quack-kludged-string-to-syntax)
    ,str))

(defun quack-kludged-string-to-syntax (str)
  (let* ((str-len (length str))
         (code    (aref str 0))
         (matches (if (> str-len 1) (aref str 1)))
         (result  (cond ((= code 32) 0)
                        ((= code ?_) 3)
                        (t (quack-internal-error))))
         (i       2))
    (while (< i str-len)
      (let ((c (aref str i)))
        (setq i (1+ i))
        (setq result (logior result
                             (lsh 1 (cond ((= c ?1) 16)
                                          ((= c ?2) 17)
                                          ((= c ?3) 18)
                                          ((= c ?4) 19)
                                          ((= c ?p) 20)
                                          ((= c ?b) 21)
                                          ((= c ?n) 21)
                                          (t (quack-internal-error))))))))
    (cons result (if (= matches 32) nil matches))))

;; Note: We are assuming that it is better to endeavor to fontify all "#|"
;;       block comments as nestable rather than as unnestable, regardless of
;;       whether or not a user's target Scheme dialect supports nested.

(defconst quack-pound-syntax-string (if quack-gnuemacs-p "_ p14bn" "_ p14b"))
;; (defconst quack-bar-syntax-string   (if quack-gnuemacs-p "  23bn"  "  23b"))
(defconst quack-bar-syntax-string   (if quack-gnuemacs-p "_ 23bn"  "_ 23b"))

(defconst quack-pound-syntax (quack-str-syntax quack-pound-syntax-string))
(defconst quack-bar-syntax   (quack-str-syntax quack-bar-syntax-string))

(modify-syntax-entry ?# quack-pound-syntax-string scheme-mode-syntax-table)
(modify-syntax-entry ?| quack-bar-syntax-string   scheme-mode-syntax-table)

;; Note: Unclear why, but `scheme.el' in GNU Emacs 21.2 is doing
;;       `(set-syntax-table scheme-mode-syntax-table)' in whatever buffer is
;;       active at the time the Elisp package is loaded.

;; Indent Properties:

(put 'begin0                 'scheme-indent-function 1)
(put 'c-declare              'scheme-indent-function 0)
(put 'c-lambda               'scheme-indent-function 2)
(put 'call-with-input-file   'scheme-indent-function 1)
(put 'call-with-input-file*  'scheme-indent-function 1)
(put 'call-with-output-file  'scheme-indent-function 1)
(put 'call-with-output-file* 'scheme-indent-function 1)
(put 'call-with-semaphore    'scheme-indent-function 1)
(put 'case-lambda            'scheme-indent-function 0)
(put 'catch                  'scheme-indent-function 1)
(put 'chicken-setup          'scheme-indent-function 1)
(put 'class                  'scheme-indent-function 'defun)
(put 'class*                 'scheme-indent-function 'defun)
(put 'compound-unit/sig      'scheme-indent-function 0)
(put 'defboolparam           'scheme-indent-function 2)
(put 'defform                'scheme-indent-function 1)
(put 'defform*               'scheme-indent-function 1)
(put 'defform*/subs          'scheme-indent-function 2)
(put 'defform/none           'scheme-indent-function 1)
(put 'defform/subs           'scheme-indent-function 2)
(put 'defidform              'scheme-indent-function 1)
(put 'define-runtime-path    'scheme-indent-function 1)
(put 'define-sequence-id     'scheme-indent-function 1)
(put 'define:                'scheme-indent-function 3)
(put 'defparam               'scheme-indent-function 3)
(put 'defproc                'scheme-indent-function 2)
(put 'defproc*               'scheme-indent-function 1)
(put 'defstruct              'scheme-indent-function 2)
(put 'defstruct*             'scheme-indent-function 2)
(put 'defthing               'scheme-indent-function 2)
(put 'deftogether            'scheme-indent-function 1)
(put 'do                     'scheme-indent-function 2)
(put 'dynamic-wind           'scheme-indent-function 0)
(put 'filebox                'scheme-indent-function 1)
(put 'for                    'scheme-indent-function 1)
(put 'for*                   'scheme-indent-function 1)
(put 'for*/and               'scheme-indent-function 1)
(put 'for*/first             'scheme-indent-function 1)
(put 'for*/fold              'scheme-indent-function 2)
(put 'for*/fold/derived      'scheme-indent-function 3)
(put 'for*/hash              'scheme-indent-function 1)
(put 'for*/hasheq            'scheme-indent-function 1)
(put 'for*/hasheqv           'scheme-indent-function 1)
(put 'for*/last              'scheme-indent-function 1)
(put 'for*/list              'scheme-indent-function 1)
(put 'for*/lists             'scheme-indent-function 2)
(put 'for*/or                'scheme-indent-function 1)
(put 'for*/product           'scheme-indent-function 1)
(put 'for*/sum               'scheme-indent-function 1)
(put 'for*/vector            'scheme-indent-function 1)
(put 'for*/vector            'scheme-indent-function 1)
(put 'for/and                'scheme-indent-function 1)
(put 'for/first              'scheme-indent-function 1)
(put 'for/fold               'scheme-indent-function 2)
(put 'for/fold               'scheme-indent-function 2)
(put 'for/fold/derived       'scheme-indent-function 3)
(put 'for/hash               'scheme-indent-function 1)
(put 'for/hasheq             'scheme-indent-function 1)
(put 'for/hasheqv            'scheme-indent-function 1)
(put 'for/last               'scheme-indent-function 1)
(put 'for/list               'scheme-indent-function 1)
(put 'for/lists              'scheme-indent-function 2)
(put 'for/or                 'scheme-indent-function 1)
(put 'for/product            'scheme-indent-function 1)
(put 'for/sum                'scheme-indent-function 1)
(put 'for/vector             'scheme-indent-function 1)
(put 'instantiate            'scheme-indent-function 2)
(put 'interface              'scheme-indent-function 1)
(put 'lambda/kw              'scheme-indent-function 1)
(put 'let*-values            'scheme-indent-function 1)
(put 'let*:                  'scheme-indent-function 'quack-let-colon-indent)
(put 'let+                   'scheme-indent-function 1)
(put 'let-values             'scheme-indent-function 1)
(put 'let/ec                 'scheme-indent-function 1)
(put 'let:                   'scheme-indent-function 'quack-let-colon-indent)
(put 'letrec-values          'scheme-indent-function 1)
(put 'match                  'scheme-indent-function 1)
(put 'match-let              'scheme-indent-function 1)
(put 'mixin                  'scheme-indent-function 2)
(put 'module                 'scheme-indent-function 'defun)
(put 'module                 'scheme-indent-function 2)
(put 'module*                'scheme-indent-function 2)
(put 'module+                'scheme-indent-function 1)
(put 'opt-lambda             'scheme-indent-function 1)
(put 'parameterize           'scheme-indent-function 1)
(put 'parameterize*          'scheme-indent-function 1)
(put 'parameterize-break     'scheme-indent-function 1)
(put 'quasisyntax/loc        'scheme-indent-function 1)
(put 'receive                'scheme-indent-function 2)
(put 'send*                  'scheme-indent-function 1)
(put 'sigaction              'scheme-indent-function 1)
(put 'specform               'scheme-indent-function 1)
(put 'specspecsubform        'scheme-indent-function 1)
(put 'specspecsubform/subs   'scheme-indent-function 2)
(put 'specsubform            'scheme-indent-function 1)
(put 'specsubform/subs       'scheme-indent-function 2)
(put 'struct                 'scheme-indent-function 1)
(put 'sxml-match             'scheme-indent-function 1)
(put 'syntax-case            'scheme-indent-function 2)
(put 'syntax-parse           'scheme-indent-function 1)
(put 'syntax/loc             'scheme-indent-function 1)
(put 'test-section           'scheme-indent-function 1)
(put 'unit                   'scheme-indent-function 'defun)
(put 'unit/sig               'scheme-indent-function 2)
(put 'unless                 'scheme-indent-function 1)
(put 'when                   'scheme-indent-function 1)
(put 'while                  'scheme-indent-function 1)
(put 'with-handlers          'scheme-indent-function 1)
(put 'with-handlers*         'scheme-indent-function 1)
(put 'with-method            'scheme-indent-function 1)
(put 'with-syntax            'scheme-indent-function 1)

(defun quack-let-colon-indent (state indent-point normal-indent)
  ;; Note: This was adapted from "scheme.el" "scheme-let-indent".
  (skip-chars-forward " \t")
  (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
      (lisp-indent-specform 4 state indent-point normal-indent)
    (lisp-indent-specform 1 state indent-point normal-indent)))

;; Keymaps:

(defvar quack-scheme-mode-keymap nil)

(setq quack-scheme-mode-keymap (make-sparse-keymap))

;; TODO: Maybe have an option to also map the Ctrl variants of each of these
;;       keys to their respective bindings.  As Eli pointed out, `C-c C-q C-x'
;;       is arguably easier to type than `C-c C-q x'.  Actually, though, I
;;       don't like the `C-c C-q' prefix at all -- it signifies everything that
;;       is wrong with traditional modifier-happy Emacs keybindings.  Maybe we
;;       should encourage users to set the prefix to some other key, like an
;;       unmodified function key.

(define-key quack-scheme-mode-keymap "f" 'quack-find-file)
(define-key quack-scheme-mode-keymap "k" 'quack-view-keyword-docs)
(define-key quack-scheme-mode-keymap "m" 'quack-view-manual)
(define-key quack-scheme-mode-keymap "r" 'run-scheme)
(define-key quack-scheme-mode-keymap "s" 'quack-view-srfi)
(define-key quack-scheme-mode-keymap "l" 'quack-toggle-lambda)
(define-key quack-scheme-mode-keymap "t" 'quack-tidy-buffer)

;; Menus:

(defmacro quack-bool-menuitem (title var &rest rest)
  (unless (stringp title) (quack-internal-error))
  (unless (symbolp var)   (quack-internal-error))
  `[,title (quack-option-toggle (quote ,var)) :style toggle :selected ,var
           ,@rest])

(defmacro quack-radio-menuitems (var alist)
  (unless (symbolp var)   (quack-internal-error))
  (unless (listp   alist) (quack-internal-error))
  `(quote ,(mapcar
            (function (lambda (pair)
                        (let ((title (car pair))
                              (value (cdr pair)))
                          (unless (stringp title) (quack-internal-error))
                          (unless (symbolp value) (quack-internal-error))
                          `[,title
                            (quack-option-set (quote ,var) (quote ,value))
                            :style    radio
                            :selected (eq ,var (quote ,value))])))
            alist)))

(defconst quack-browser-radio-alist
  '((nil                                . "(Browse-URL Default)")
    (browse-url-galeon                  . "Galeon")
    (browse-url-mozilla                 . "Mozilla")
    (browse-url-kde                     . "KDE Konqueror")
    (browse-url-netscape                . "Netscape Navigator")
    (browse-url-w3                      . "Emacs W3")
    (w3m-browse-url                     . "W3M")
    (quack-w3m-browse-url-other-window  . "W3M (in other window)")
    (browse-url-lynx-xterm              . "Lynx in Xterm")
    (browse-url-lynx-emacs              . "Lynx in Emacs")
    (browse-url-default-windows-browser . "MS Windows Default")))

(defconst quack-global-menuspec
  `("Quack"
    ["About Quack..." quack-about]
    ("Options"
     ("Startup Options"
      "These settings take full effect"
      "once Emacs is restarted."
      "---"
      ,(quack-bool-menuitem "Put Quack on Global Menu Bar" quack-global-menu-p)
      ,(quack-bool-menuitem "Remap Find-File Bindings"
                            quack-remap-find-file-bindings-p)
      "---"
      ["Quack Directory..." (customize-option 'quack-dir)]
      ["Quack Scheme Mode Keymap Prefix..."
       (customize-option 'quack-scheme-mode-keymap-prefix)])
     "---"
     ("Default Program" :filter quack-defaultprogram-menufilter)
     ,(quack-bool-menuitem "Always Prompt for Program"
                           quack-run-scheme-always-prompts-p)
     ,(quack-bool-menuitem "Program Prompt Defaults to Last"
                           quack-run-scheme-prompt-defaults-to-last-p)
     ,(quack-bool-menuitem "Remember New Programs"
                           quack-remember-new-programs-p)
     "---"
     ("Newline Behavior"
      ,@(quack-radio-menuitems
         quack-newline-behavior
         (("Newline"               . newline)
          ("Newline-Indent"        . newline-indent)
          ("Indent-Newline-Indent" . indent-newline-indent))))
     ,(quack-bool-menuitem "Smart Open-Paren"
                           quack-smart-open-paren-p)
     ("Switch-to-Scheme Method"
      ,@(quack-radio-menuitems quack-switch-to-scheme-method
                               (("Other Window"       . other-window)
                                ("Own Frame"          . own-frame)
                                ("Cmuscheme Behavior" . cmuscheme)))
      "---"
      ,(quack-bool-menuitem
        "Warp Pointer to Frame"
        quack-warp-pointer-to-frame-p
        :active (eq quack-switch-to-scheme-method 'own-frame)))
     ("Fontification"
      ,@(quack-radio-menuitems quack-fontify-style
                               (("PLT Style"                . plt)
                                ("Extended GNU Emacs Style" . emacs)
                                ("Emacs Default"            . nil)))
      "---"
      ,(quack-bool-menuitem "Pretty Lambda \(in PLT Style\)"
                            quack-pretty-lambda-p
                            :active (and quack-pretty-lambda-supported-p
                                         (memq quack-fontify-style '(plt))))
      ,(quack-bool-menuitem "Fontify Definition Names \(in PLT Style\)"
                            quack-pltish-fontify-definition-names-p
                            :active (eq quack-fontify-style 'plt))
      ,(quack-bool-menuitem "Fontify Syntax Keywords \(in PLT Style\)"
                            quack-pltish-fontify-keywords-p
                            :active (eq quack-fontify-style 'plt))
      ;; TODO: Add menuitem here for "Fontify #: Keywords \(in PLT Style\)"
      ,(quack-bool-menuitem "Fontify 3-Semicolon Comments \(in PLT Style\)"
                            quack-fontify-threesemi-p
                            :active (memq quack-fontify-style '(plt)))
      )
     ("Web Browser"
      ,@(mapcar (function
                 (lambda (n)
                   (let ((func  (car n))
                         (title (cdr n)))
                     `[,title
                       (quack-option-set 'quack-browse-url-browser-function
                                         (quote ,func))
                       :style radio
                       :selected ,(if (not func)
                                      '(not quack-browse-url-browser-function)
                                    `(eq quack-browse-url-browser-function
                                         (quote ,func)))])))
                quack-browser-radio-alist)
      ["(Other)..."
       (customize-option 'quack-browse-url-browser-function)
       :style    radio
       :selected (not (assq quack-browse-url-browser-function
                            quack-browser-radio-alist))])
     ,(quack-bool-menuitem "Tab Characters are Evil" quack-tabs-are-evil-p)
     ("Local Keywords for Remote Manuals"
      ,@(quack-radio-menuitems
         quack-local-keywords-for-remote-manuals-p
         (("Permit" . t)
          ("Forbid" . nil)
          ("Always" . always))))
     ["PLT Collection Directories..."
      (customize-option 'quack-pltcollect-dirs)]
     "---"
     ["Customize..." quack-customize])
    "---"
    ["Run Scheme"              run-scheme]
    ["Switch to Scheme Buffer" switch-to-scheme]
    "---"
    ("View Manual" :filter quack-view-manual-menufilter)
    ("View SRFI"   :filter quack-view-srfi-menufilter)
    ["View Keyword Docs..."       quack-view-keyword-docs]
    ["Dired on PLT Collection..." quack-dired-pltcollect]))

(defun quack-install-global-menu ()
  (when quack-global-menu-p
    (quack-when-gnuemacs
     (unless (assq 'Quack menu-bar-final-items)
       (setq menu-bar-final-items (cons 'Quack menu-bar-final-items)))
     (easy-menu-define quack-global-menu global-map ""
       quack-global-menuspec))
    (quack-when-xemacs
     ;; Die! Die! Die!
     ;;(mapcar (function (lambda (n)
     ;;(delete-menu-item '("Quack") n)
     ;;(add-submenu nil quack-global-menuspec "Help" n)))
     ;;(list 
     ;;;;current-menubar 
     ;;default-menubar
     ;;))
     (delete-menu-item '("Quack") current-menubar)
     (add-submenu nil quack-global-menuspec "Help" current-menubar)
     (set-menubar-dirty-flag))))

;; TODO: We should make sure the user's custom settings have been loaded
;; before we do this.
(quack-install-global-menu)

;; And die some more!
;;(quack-when-xemacs (add-hook 'after-init-hook 'quack-install-global-menu))

(defconst quack-scheme-mode-menuspec
  `("Scheme"
    ("Quack Global" ,@(cdr quack-global-menuspec))
    "---"
    ["Toggle Lambda Syntax"          quack-toggle-lambda]
    ["Tidy Buffer Formatting"        quack-tidy-buffer]
    ["Comment-Out Region"            comment-region]
    ["Un-Comment-Out Region"         quack-uncomment-region]
    "---"
    ["Evaluate Last S-expression"    scheme-send-last-sexp]
    ["Evaluate Region"               scheme-send-region]
    ["Evaluate Region & Go"          scheme-send-region-and-go]
    ["Evaluate Last Definition"      scheme-send-definition]
    ["Evaluate Last Definition & Go" scheme-send-definition-and-go]
    ["Compile Definition"            scheme-compile-definition]
    ["Compile Definition & Go"       scheme-compile-definition-and-go]
    ["Load Scheme File"              scheme-load-file]
    ["Compile Scheme File"           scheme-compile-file]
    "---"
    ["View Keyword Docs..."          quack-view-keyword-docs]
    ["Quack Find File"               quack-find-file]))

(defvar quack-scheme-mode-menu)
(quack-when-gnuemacs
 (let ((map (make-sparse-keymap)))
   (setq quack-scheme-mode-menu nil)
   (easy-menu-define quack-scheme-mode-menu map ""
     quack-scheme-mode-menuspec)
   (define-key scheme-mode-map [menu-bar scheme]
     (cons "Scheme"
           (or (lookup-key map [menu-bar Scheme])
               (lookup-key map [menu-bar scheme]))))))

(defun quack-view-manual-menufilter (arg)
  (quack-menufilter-return "quack-view-manual-menufilter-menu"
                           (quack-manuals-menu)))

(defun quack-view-srfi-menufilter (arg)
  (quack-menufilter-return
   "quack-view-srfi-menufilter-menu"
   (condition-case nil
       (quack-srfi-menu t)
     ;; TODO: Move the generation of this fallback menu down to
     ;;       quack-srfi-menu.
     (error '(["Update SRFI Index" quack-update-srfi-index]
              "---"
              ("Draft"     :active nil "")
              ("Final"     :active nil "")
              ("Withdrawn" :active nil "")
              ["Other SRFI..."     quack-view-srfi])))))

(defun quack-defaultprogram-menufilter (arg)
  (quack-menufilter-return
   "quack-defaultprogram-menufilter-menu"
   `(,@(quack-optionmenu-items-setdefaultprogram)
       "---"
       ["Other Program..." quack-set-other-default-program]
       "---"
       ("Forget Program"
        ,@(mapcar
           (function
            (lambda (program)
              `[,(format "Forget  %s" program)
                (quack-forget-program ,program)]))
           quack-programs)))))

(defun quack-optionmenu-items-setdefaultprogram ()
  (let* ((programs      (quack-sort-string-list-copy quack-programs))
         (add-default-p (and quack-default-program
                             (not (member quack-default-program programs)))))
    (and add-default-p
         (setq programs (cons quack-default-program programs)))
    (mapcar
     (function
      (lambda (program)
        (let* ((selected-p (and quack-default-program
                                (equal program quack-default-program))))
          `[,(format "%s%s"
                     program
                     (if (and add-default-p
                              (equal program quack-default-program))
                         " (temporary)"
                       ""))
            (quack-option-set 'quack-default-program ,program)
            :style radio :selected ,selected-p])))
     programs)))

(mapcar (function (lambda (sym) (put sym 'menu-enable 'mark-active)))
        '(comment-region
          indent-region
          quack-uncomment-region
          scheme-send-region
          scheme-send-region-and-go))

;; Option Menu Callbacks:

(defun quack-set-other-default-program ()
  (interactive)
  (let* ((minibuffer-allow-text-properties nil)
         (program (quack-without-side-whitespace
                   (read-string "Other Default Program: "))))
    (if (string= program "")
        (message "Default program unchanged.")
      (quack-remember-program-maybe program)
      (quack-option-set 'quack-default-program
                        program))))

(defun quack-forget-program (program)
  (setq quack-programs (delete program quack-programs))
  (quack-option-set 'quack-programs quack-programs t)
  (message "Forgot program %S." program))

(defun quack-custom-set (sym value)
  ;; Clean up the value based on the variable symbol.
  (cond ((eq sym 'quack-programs)
         (setq value (quack-sort-string-list-copy value))))

  ;; Set default binding.  Set local binding just for the halibut, although if
  ;; there are local bindings, then other things will likely break.  \(We used
  ;; to have a check here, but removed it while porting to XEmacs.\)
  (set         sym value)
  (set-default sym value)

  ;; TODO: Probably don't do this during Emacs initialization time, to avoid
  ;;       unnecessary behavior like:
  ;;
  ;;           Loading ~/emacs/my-custom.el (source)...
  ;;           Updating Scheme Mode buffers...done
  ;;           Updating Scheme Mode buffers...done
  ;;           Updating Scheme Mode buffers...done
  ;;           Updating Scheme Mode buffers...done
  ;;           Updating Scheme Mode buffers...done
  ;;           Loading ~/emacs/my-custom.el (source)...done
  
  ;; Update dependent program state.
  (cond ((memq sym '(quack-emacsish-keywords-to-fontify
                     quack-fontify-style
                     quack-fontify-threesemi-p
                     quack-pltish-fontify-definition-names-p
                     quack-pltish-fontify-keywords-p
                     quack-pltish-keywords-to-fontify
                     quack-pretty-lambda-p))
         (quack-update-scheme-mode-buffers))

        ((eq sym 'quack-local-keywords-for-remote-manuals-p)
         (quack-invalidate-manuals-caches))

        ((eq sym 'quack-pltcollect-dirs)
         (quack-invalidate-pltcollects-caches))))

(defun quack-option-set (sym value &optional silently)
  (if quack-options-persist-p
      (customize-save-variable sym value)
    (quack-custom-set sym value))
  (or silently
      (message "Set %s%s to: %S"
               sym
               (if quack-options-persist-p "" " (non-persistently)")
               value)))

(defun quack-option-toggle (sym &optional silently)
  (quack-option-set sym (not (symbol-value sym)) t)
  (or silently
      (message "Set %s%s %s."
               sym
               (if quack-options-persist-p "" " (non-persistently)")
               (if (symbol-value sym) "ON" "OFF"))))

(defun quack-update-scheme-mode-buffers ()
  (save-excursion
    (quack-activity
     "Updating Scheme Mode buffers"
     (mapcar (function
              (lambda (buf)
                (set-buffer buf)
                (when (eq major-mode 'scheme-mode)
                  (quack-activity (format "Updating buffer %S" (buffer-name))
                                  (scheme-mode)))))
             (buffer-list)))))

;; Pretty Lambda:

(defconst quack-lambda-char (make-char 'greek-iso8859-7 107))

(defconst quack-pretty-lambda-supported-p
  (and quack-gnuemacs-p (>= emacs-major-version 21)))

;; Font Lock:

(defconst quack-emacsish1-font-lock-keywords
  `((,(concat "[[(]"
              "\\("                     ; #<1
              "define\\*?"
                                        ; #=2 #=3
              (quack-re-alt (quack-re-alt ""
                                          "-generic"
                                          "-generic-procedure"
                                          "-method"
                                          "-public"
                                          "/kw"
                                          "/override"
                                          "/private"
                                          "/public")
                                        ; #=4
                            (quack-re-alt "-macro"
                                          "-syntax")
                            "-class"
                            "-module"
                            "-signature"
                            "-struct")
              "\\)"                     ; #>1
              "\\>"
              "[ \t]*[[(]?"
                                        ; #=5
              "\\(\\sw+\\)?")
     (1 font-lock-keyword-face)
     (5 (cond ((match-beginning 3) font-lock-function-name-face)
              ((match-beginning 4) font-lock-variable-name-face)
              (t                   font-lock-type-face))
        nil t))

    ;; PLT module definitions.
    ("[[(]\\(module\\)\\>[ \t]+\\(\\sw+\\)?"
     (1 font-lock-keyword-face)
     (2 font-lock-type-face nil t))))

(defconst quack-emacsish2-font-lock-keywords
  (append quack-emacsish1-font-lock-keywords
          `(
            ;; Misc. keywords.
            (,(concat
               "[[(]\\("
               (regexp-opt quack-emacsish-keywords-to-fontify)
               "\\)\\>")
             . 1)
            ;; Class specifiers in SOS, Stklos, Goops.
            ("\\<<\\sw+>\\>" . font-lock-type-face)
            ;; Colon keywords.
            ("\\<:\\sw+\\>" . font-lock-builtin-face))))

(defvar quack-pltish-font-lock-keywords nil)

(defun quack-pltish-num-re (radix digit base16-p)
  ;; These regexps started as a transliteration of the R5RS BNF to regular
  ;; expressions, adapted for PLTisms, and with a few optimizations.
  ;;
  ;; PLTisms are that 'e' is not permitted as an exponent marker in base-16
  ;; literals, and that "decimal-point" forms are permitted in any radix.
  ;;
  ;; There's obvious opportunity for further optimization, especially if we
  ;; relax the accepted syntax a little.  These regexps have not been tested
  ;; much, but, since this is only Emacs syntax fontification, false-positives
  ;; and false-negatives will be obvious yet benign.
  (let* ((uint    (concat digit "+#*"))
         (sign    "[-+]?")
         (suffix  (quack-re-optional (if base16-p "[sSfFdDlL]" "[eEsSfFdDlL]")
                                     sign
                                     "[0-9]+"))
         (decimal (quack-re-alt
                   (concat uint suffix)
                   (concat "\\." digit "+#*" suffix)
                   (concat digit
                           "+"
                           (quack-re-alt (concat "\\." digit "*")
                                         "#+\\.")
                           "#*")))
         (ureal   (quack-re-alt uint
                                (concat uint "/" uint)
                                decimal))
         (real    (concat sign ureal))
         (complex (quack-re-alt
                   (concat real
                           (quack-re-alt (concat "@" real)
                                         (quack-re-optional
                                          "[-+]"
                                          (quack-re-optional ureal)
                                          "i")
                                         ""))
                   (concat "[-+]" (quack-re-optional ureal) "i")))
         (exact   (quack-re-optional "#[eEiI]"))
         (prefix  (quack-re-alt (concat radix exact)
                                (concat exact radix))))
    (concat "\\<" prefix complex "\\>")))

(defconst quack-pltish-fls-base
  `(
    ("\\`\\(MrEd\\|Welcome to MzScheme\\) v[^\n]+" . quack-banner-face)
    ("\\`Gambit Version 4\\.0[^\n]*" . quack-banner-face)
    ("\\`Welcome to scsh [0-9][^\n]+\nType ,\\? for help[^\n]+"
     . quack-banner-face)
    ("\\`MIT/GNU Scheme running under [^\n]+" . quack-banner-face)
    ;;("\\`; This is the CHICKEN interpreter - Version [^\n]+\n; (c)[^\n]+"
    ;; . quack-banner-face)
    ;;("\\`Scheme Microcode Version[^\n]+\nMIT Scheme[^\n]+\n\\([^\n]+\n\\)+" .
    ;;quack-banner-face)
    ;; Unix cookie line.
    ("\\`#![^\r\n]*" . quack-pltish-comment-face)
    ;; Colon keywords:
    ("\\<#:\\sw+\\>" . quack-pltish-colon-keyword-face)
    ;; Self-evals:
    ("'\\sw+\\>"                . quack-pltish-selfeval-face)
    ("'|\\(\\sw\\| \\)+|"       . quack-pltish-selfeval-face)
    ;; Note: The first alternative in the following rule will misleadingly
    ;; fontify some invalid syntax, such as "#\(x".
    ("\\<#\\\\\\([][-`~!@#$%&*()_+=^{}\;:'\"<>,.?/|\\\\]\\|\\sw+\\>\\)"
     . quack-pltish-selfeval-face)
    ("[][()]"                   . quack-pltish-paren-face)
    ("\\<#\\(t\\|f\\)\\>"       . quack-pltish-selfeval-face)
    ("\\<+\\(inf.0\\|nan\\)\\>" . quack-pltish-selfeval-face)
    ("\\<-inf.0\\>"             . quack-pltish-selfeval-face)
    ,@(mapcar (function (lambda (args)
                          (cons (apply 'quack-pltish-num-re args)
                                'quack-pltish-selfeval-face)))
              '(("#b"        "[01]"        nil)
                ("#o"        "[0-7]"       nil)
                ("\\(#d\\)?" "[0-9]"       nil)
                ("#x"        "[0-9a-fA-F]" t)))))

(defconst quack-pltish-fls-defnames
  ;; TODO: Optimize these once they're fairly complete and correct.

  ;; TODO: Would be nice to fontify binding names everywhere they are
  ;;       introduced, such as in `let' and `lambda' forms.  That may require
  ;;       real parsing to do reasonably well -- the kludges get too bad and
  ;;       slow, and font-lock gets in the way more than it helps.

  `(
                                        ;,@quack-pltish-font-lock-keywords

    ;; Lots of definition forms that start with "define".
    (,(concat "[[(]"
              "define\\*?"
              ;; TODO: make this into regexp-opt
              (quack-re-alt ""
                            ":"
                            "-class"
                            "-class"
                            "-const-structure"
                            "-constant"
                            "-embedded"
                            "-entry-point"
                            "-external"
                            "-for-syntax"
                            "-foreign-record"
                            "-foreign-type"
                            "-foreign-variable"
                            "-generic"
                            "-generic-procedure"
                            "-inline"
                            "-location"
                            "-macro"
                            "-method"
                            "-opt"
                            "-parameters"
                            "-public"
                            "-reader-ctor"
                            "-record"
                            "-record-printer"
                            "-record-type"
                            "-signature"
                            "-structure"
                            "-syntax"
                            "-values"
                            "-values-for-syntax"
                            "/contract"
                            "/override"
                            "/private"
                            "/public")
              "\\>"
              "[ \t]*[[(]?"
              "\\(\\sw+\\)")
     (2 (let ((name (quack-match-string-no-properties 2)))
          (if (= (aref name (1- (length name))) ?%)
              quack-pltish-class-defn-face
            quack-pltish-defn-face))
        nil t))

    ;; Racket "struct" and "define-struct" forms:
    (,(concat "[[(]"
              "\\(?:define-\\)?"
              "struct"
              "\\>"
              "[ \t]*[[(]?"
              "\\(\\sw+\\)")
     ;; TODO: Use a struct face rather than the class face.
     (1 quack-pltish-class-defn-face nil t))

    ;; `defmacro' and related SCM forms.
    (,(concat "[[(]def"
              (quack-re-alt (concat "macro"
                                    (quack-re-alt "" "-public"))
                            "syntax")
              "\\>[ \t]+\\(\\sw+\\)")
     3 quack-pltish-defn-face nil t)

    ;; `defmac' from SIOD.
    ("[[(]defmac[ \t]+[[(][ \t]*\\(\\sw+\\)"
     1 quack-pltish-defn-face nil t)

    ;; `defvar' and `defun' from SIOD.
    (,(concat "[[(]def"
              (quack-re-alt "un"
                            "var")
              "[ \t]+\\(\\sw+\\)")
     2 quack-pltish-defn-face nil t)

    ;; Guile and Chicken `define-module'.
    ("[[(]define-module\\>[ \t]+[[(][ \t]*\\(\\sw+\\([ \t]+\\sw+\\)*\\)"
     1 quack-pltish-module-defn-face nil t)

    ;; PLT `define-values', `define-syntaxes', and `define-syntax-set'.
    (,(concat "[[(]define-"
              (quack-re-alt "values" "syntax-set" "syntaxes")
              "\\>[ \t]+[[(][ \t]*\\(\\sw+\\([ \t]+\\sw+\\)*\\)")
     2 quack-pltish-defn-face nil t)

    ;; PLT `module'.
    ("[[(]module\\>[ \t]+\\(\\sw+\\)"
     1 quack-pltish-module-defn-face nil t)

    ;; Named `let'.  (Note: This is disabled because it's too incongruous.)
    ;;("[[(]let\\>[ \t]+\\(\\sw+\\)"
    ;; 1 quack-pltish-defn-face nil t)
    ))

;; TODO: Adding PLT-style (quasi)quoted list fontifying is obviously not doable
;;       with just regexps.  Probably requires either cloning
;;       `font-lock-default-fontify-region' just to get it to call our
;;       replacement syntactic pass fontification function, *or*
;;       before-advising `font-lock-fontify-keywords-region' to perform our
;;       syntactic pass when in scheme-mode, and around-advising
;;       `font-lock-fontify-syntactically-region' to not do anything for
;;       scheme-mode (or maybe setting `font-lock-keywords-only' to non-nil,
;;       unless that breaks something else).  Or just ditch font-lock.  See
;;       `font-lock-fontify-region-function' variable in font-lock specs.

;; (defconst quack-pltish-fls-keywords
;;   `((,(concat
;;        "[[(]\\("
;;        (regexp-opt quack-pltish-keywords-to-fontify)
;;        "\\)\\>")
;;      (1 quack-pltish-keyword-face))))

(defun quack-install-fontification ()

  (when (eq quack-fontify-style 'plt)
    (set (make-local-variable 'font-lock-comment-face)
         'quack-pltish-comment-face)
    (set (make-local-variable 'font-lock-string-face)
         'quack-pltish-selfeval-face))

  (let* ((sk  `(("\\(#\\)\\(|\\)"
                 (1 ,quack-pound-syntax)
                 (2 ,quack-bar-syntax))
                ("\\(|\\)\\(#\\)"
                 (1 ,quack-bar-syntax)
                 (2 ,quack-pound-syntax))))
         (pl  (if (and quack-pretty-lambda-supported-p quack-pretty-lambda-p)
                  '(("[[(]\\(case-\\|match-\\|opt-\\)?\\(lambda\\)\\>"
                     2
                     (progn (compose-region (match-beginning 2)
                                            (match-end       2)
                                            quack-lambda-char)
                            nil)))
                '()))
         (threesemi
          (if quack-fontify-threesemi-p
              `(
                (,(concat "^\\(\;\;\;\\)"
                          ;; TODO: Make this enforce space or newline after the
                          ;; three semicolons.
                          "\\("
                          "[ \t]*"
                          "\\("
                          "[^\r\n]*"
                          "\\)"
                          "\r?\n?\\)")
                 (1 quack-threesemi-semi-face prepend)
                 (2 quack-threesemi-text-face prepend)
                 ;;(4 quack-threesemi-h1-face   prepend)
                 ;;(5 quack-threesemi-h2-face   prepend)
                 )

                ;; Funcelit:
                ("^\;\;\; @\\(Package\\|section\\|unnumberedsec\\)[ \t]+\\([^\r\n]*\\)"
                 (2 quack-threesemi-h1-face prepend))
                ("^\;\;\; @subsection[ \t]+\\([^\r\n]*\\)"
                 (1 quack-threesemi-h2-face prepend))

                ("^\;\;\; @section\\(?:\\[[^]]*\\]\\)?{\\([^\r\n]*\\)}"
                 (1 quack-threesemi-h1-face prepend))
                ("^\;\;\; @subsection\\(?:\\[[^]]*\\]\\)?{\\([^\r\n]*\\)}"
                 (1 quack-threesemi-h2-face prepend))
                
                
                )
            '()))
         (fld `(,(cond
                  ((eq quack-fontify-style 'plt)
                   (set (make-local-variable
                         'quack-pltish-font-lock-keywords)
                        `(,@quack-pltish-fls-base
                          ,@(if quack-pltish-fontify-definition-names-p
                                quack-pltish-fls-defnames
                              '())
                          ,@pl
                          ,@(if quack-pltish-fontify-keywords-p
                                ;; quack-pltish-fls-keywords
                                `((,(concat
                                     "[[(]\\("
                                     (regexp-opt
                                      quack-pltish-keywords-to-fontify)
                                     "\\)\\>")
                                   (1 quack-pltish-keyword-face)))
                              '())
                          ,@threesemi
                          ))
                   'quack-pltish-font-lock-keywords)
                  ((eq quack-fontify-style 'emacs)
                   ;; TODO: Do pretty-lambda here too.  But first get rid of
                   ;;       this font-lock style "degrees of general gaudiness"
                   ;;       and switch to separate options for each property of
                   ;;       fontification.
                   '(quack-emacsish1-font-lock-keywords
                     quack-emacsish1-font-lock-keywords
                     quack-emacsish2-font-lock-keywords))
                  (t (quack-internal-error)))
                nil
                t
                ((?! . "w") (?$ . "w") (?% . "w") (?& . "w") (?* . "w")
                 (?+ . "w") (?- . "w") (?. . "w") (?/ . "w") (?: . "w")
                 (?< . "w") (?= . "w") (?> . "w") (?? . "w") (?@ . "w")
                 (?^ . "w") (?_ . "w") (?~ . "w")
                 ,@(if (eq quack-fontify-style 'plt)
                       '((?# . "w"))
                     '()))
                ;; TODO: Using `beginning-of-defun' here could be very slow,
                ;;       say, when you have a large buffer that is wrapped in a
                ;;       `module' form.  Look into whether this is a problem.
                beginning-of-defun
                ,@(if t                 ; quack-gnuemacs-p
                      `((font-lock-mark-block-function . mark-defun)
                        (font-lock-syntactic-keywords  . ,sk))
                    '()))))

    ;; TODO: Figure out why `font-lock-syntactic-keywords' just doesn't work in
    ;;       XEmacs 21, even though the syntax text properties seem to get set.
    ;;       We have already beaten it like an egg-sucking dog.

    ;;(if quack-xemacs-p
    ;;(put 'scheme-mode 'font-lock-defaults fld)
    (set (make-local-variable 'font-lock-defaults) fld)
    ;;)

    ;;(when quack-xemacs-p
    ;;  (set (make-local-variable 'font-lock-syntactic-keywords)
    ;;       syntactic-keywords))
    ))

;; Scheme Mode Startup Hook:

(defun quack-locally-steal-key-bindings (old-func new-func)
  (mapcar (function (lambda (key)
                      (unless (and (vectorp key)
                                   (eq (aref key 0) 'menu-bar))
                        (local-set-key key new-func))))
          (where-is-internal old-func)))

(defun quack-shared-mode-hookfunc-stuff ()

  ;; Install the Quack keymap and menu items.
  (local-set-key quack-scheme-mode-keymap-prefix quack-scheme-mode-keymap)
  (quack-when-xemacs
   (when (featurep 'menubar)
     ;;(set-buffer-menubar current-menubar)
     ;; TODO: For XEmacs, we could have two versions of this menu -- the popup
     ;;       one would have the Global submenu, but the menubar one would have
     ;;       the Global submenu only if quack-global-menu-p were nil.
     (add-submenu nil quack-scheme-mode-menuspec)
     (set-menubar-dirty-flag)
     (setq mode-popup-menu quack-scheme-mode-menuspec)))

  ;; Bind the paren-matching keys.
  (local-set-key ")" 'quack-insert-closing-paren)
  (local-set-key "]" 'quack-insert-closing-bracket)

  (local-set-key "(" 'quack-insert-opening-paren)
  (local-set-key "[" 'quack-insert-opening-bracket)

  ;; Steal any find-file bindings.
  (when quack-remap-find-file-bindings-p
    (quack-locally-steal-key-bindings 'find-file     'quack-find-file)
    (quack-locally-steal-key-bindings 'ido-find-file 'quack-find-file))

  ;; Fight against tabs.
  (when quack-tabs-are-evil-p
    (setq indent-tabs-mode nil))

  ;; Remove character compositions, to get rid of any pretty-lambda.  (Note:
  ;; This is bad, if it turns out compositions are used for other purposes in
  ;; buffers that are edited with Scheme Mode.)
  (when quack-pretty-lambda-supported-p
    (eval '(decompose-region (point-min) (point-max))))

  ;; Install fontification
  (when quack-fontify-style
    (when (and (boundp 'font-lock-keywords)
               (symbol-value 'font-lock-keywords)
               (not (featurep 'noweb-mode)))
      ;; This warning is not given if the `noweb-mode' package is installed.
      (quack-warning "`font-lock-keywords' already set when hook ran."))
    (quack-install-fontification))

  ;; Die! Die! Die!
  (quack-when-xemacs
   (quack-install-global-menu)))

(defun quack-inferior-scheme-mode-hookfunc ()
  (quack-shared-mode-hookfunc-stuff))

(defun quack-scheme-mode-hookfunc ()
  (quack-shared-mode-hookfunc-stuff)

  ;; Bind Return/Enter key.
  (local-set-key "\r" 'quack-newline)

  ;; Install toolbar.
  ;;(unless quack-xemacs-p
  ;;(when (display-graphic-p)
  ;;(quack-install-tool-bar)))
  )

(add-hook 'scheme-mode-hook          'quack-scheme-mode-hookfunc)
(add-hook 'inferior-scheme-mode-hook 'quack-inferior-scheme-mode-hookfunc)

;; Compilation Mode:

;; TODO: Add compilation-directory-matcher support for "setup-plt:  in".

(defvar quack-saved-compilation-error-regexp-alist nil)

(defconst quack-compilation-error-regexp-alist-additions
  (let ((no-line (if quack-xemacs-p
                     (let ((m (make-marker))) (set-marker m 0) m)
                   'quack-compile-no-line-number)))
  `(

    ;; Racket 5.1.1 "raco" compile error (which can have multiple spaces):
    ("^raco\\(?:cgc\\)?: +\\([^: ][^:]*\\):\\([0-9]+\\):\\([0-9]+\\):"
     1 2 3)

    ;; Racket 5.1.1 entries without line number info in "=== context ===":
    ("^\\(/[^:]+\\): \\[running body\\]$" 1 nil nil 0)

    ;; PLT MzScheme 4.1.4 "=== context ===" traceback when there is only file,
    ;; line, and column info, but potentially no following ":" and additional
    ;; info like procedure name.
    ("^\\([^:\n\" ]+\\):\\([0-9]+\\):\\([0-9]+\\)" 1 2 3)

    ;; PLT MzScheme 205 "setup-plt"
    ;;   load-handler: expected a `module' declaration for `bar-unit' in
    ;;   "/u/collects/bar/bar-unit.ss", but found something else
    (,(concat "load-handler: expected a `module' declaration for `[^']+' in "
              "\"\\([^:\n\"]+\\)\", but found something else")
     1 ,no-line)

    ;; PLT MzScheme 205 "setup-plt".
    ;;   setup-plt: Error during Compiling .zos for Foo Bar (/u/collects/fb)
    ("setup-plt: Error during Compiling .zos for [^\n]+ \(\\([^\n\)]+\\)\)"
     1 ,no-line)

    ;; PLT MzScheme 4.0.1 "setup-plt".
    ("setup-plt: +\\(?:WARNING: +\\)\\([^:\n]+\\)::"
     1 ,no-line)

    ;; PLT MzScheme 4.0.1 "setup-plt".
    ("setup-plt: +\\(?:WARNING: +\\)\\([^:\n ][^:\n]*\\):\\([0-9]+\\):\\([0-9]+\\)"
     1 2 3)

    ;; PLT MzScheme 4.0.1 "setup-plt":
    ("load-handler: expected a `module' declaration for `[^'\n]+' in #\n]+\\)>[^\n]+"
     1 ,no-line)

    ;; PLT Scheme 4.1.2 "default-load-handler" error without useful filename:
    ("default-load-handler: cannot open input-file: "
     nil ,no-line)

    )))

(defun quack-compile-no-line-number (filename column)
  (list (point-marker) filename 1 (and column (string-to-number column))))

(defun quack-install-compilation-mode-stuff ()
  (unless quack-saved-compilation-error-regexp-alist
    (setq quack-saved-compilation-error-regexp-alist 
          compilation-error-regexp-alist))
  (setq compilation-error-regexp-alist
        (append quack-compilation-error-regexp-alist-additions
                quack-saved-compilation-error-regexp-alist)))

(quack-install-compilation-mode-stuff)

;; Interpreter-mode-alist:

(defvar quack-saved-interpreter-mode-alist nil)

(defvar quack-interpreter-mode-alist-additions
  (mapcar (function (lambda (x)
                      (cons x 'scheme-mode)))
          '("bigloo"
            "csi"
            "gosh"
            "gsi"
            "guile"
            "kawa"
            "mit-scheme"
            "mred"
            "mred3m"
            "mredcgc"
            "mzscheme"
            "mzscheme3m"
            "mzschemecgc"
            "r5rs"
            "r6rs"
            "rs"
            "rs"
            "scheme"
            "scheme48"
            "scsh"
            "sisc"
            "stklos"
            "sxi")))

(defun quack-install-interpreter-mode-alist ()
  (unless quack-saved-interpreter-mode-alist
    (setq quack-saved-interpreter-mode-alist
          interpreter-mode-alist))
  (setq interpreter-mode-alist
        (append quack-interpreter-mode-alist-additions
                quack-saved-interpreter-mode-alist)))

(quack-install-interpreter-mode-alist)

;; PLT Package Mode:

;; TODO: Do some simple checking and summarize what directories and files are
;;       getting modified by this package.

;; TODO: Maybe don't worry about preserving the decompressed text verbatim in
;;       the buffer -- set markers and generate headings, and be able to
;;       construct valid package.

;; TODO: Command to install package from original file using "setup-plt".

;; TODO: Fontify Scheme code file contents.

(defvar quack-pltfile-mode-hook nil)

(defvar quack-hiding-ovlcat)
(put 'quack-hiding-ovlcat 'face       'default)
(put 'quack-hiding-ovlcat 'intangible t)
(put 'quack-hiding-ovlcat 'invisible  t)

(defvar quack-pltfile-mode-map (make-sparse-keymap))
(define-key quack-pltfile-mode-map "q" 'quack-pltfile-quit)
(define-key quack-pltfile-mode-map "r" 'quack-pltfile-raw)
(define-key quack-pltfile-mode-map " " 'scroll-up)

;; TODO: Make a menu map for pltfile-mode.

(defun quack-pltfile-mode ()
  (interactive)
  "Major mode for viewing PLT Scheme `.plt' package files.

\\{quack-pltfile-mode-map}

Provided by Quack: http://www.neilvandyke.org/quack/"
  (kill-all-local-variables)
  (put 'quack-pltfile-mode 'mode-class 'special)
  (setq major-mode 'quack-pltfile-mode)
  (setq mode-name "PLT Package")
  (use-local-map quack-pltfile-mode-map)
  ;; Note: Currently, the `font-lock' feature is always defined, since we
  ;; require it.
  (when (featurep 'font-lock)
    (setq font-lock-defaults nil))
  (buffer-disable-undo)
  (let ((saved-bmp (buffer-modified-p)))
    (quack-activity "Decoding PLT package" (quack-pltfile-decode-buffer))
    (setq buffer-read-only t)
    (set-buffer-modified-p saved-bmp))
  (quack-when-xemacs
   (make-variable-buffer-local 'write-contents-hooks))
  (add-hook 'write-contents-hooks 'quack-prevent-pltfile-write)
  (run-hooks 'quack-pltfile-mode-hook)
  (message "Decoded PLT package.  %s"
           (substitute-command-keys
            (concat "`\\[quack-pltfile-quit]' to quit"
                    ", `\\[quack-pltfile-raw]' for raw format."))))

(defun quack-prevent-pltfile-write ()
  (unless (yes-or-no-p
           "Write a decoded PLT package buffer?!  Are you *sure*?!")
    (error "Aborted write of decoded PLT package buffer.")))

(defun quack-pltfile-raw ()
  (interactive)
  (let ((auto-mode-alist '()))
    (setq buffer-read-only nil)
    (widen)
    (delete-region (point-min) (point-max))
    (fundamental-mode)
    (revert-buffer t t)))

(defun quack-pltfile-quit ()
  (interactive)
  (kill-buffer (current-buffer)))

(defun quack-skip-whitespace-to-nonblank-line-beginning ()
  (save-match-data
    (while (looking-at "[ \t\r\f]*\n")
      (goto-char (match-end 0)))))

(defun quack-pltfile-decode-buffer ()

  ;; MIME Base-64 decode.  (Note: an error is signaled if this fails.)
  (base64-decode-region (point-min) (point-max))

  ;; Gzip decompress.
  (let ((coding-system-for-write (if quack-xemacs-p 'binary 'raw-text-unix))
        (coding-system-for-read  (if quack-xemacs-p 'binary 'raw-text-unix))
        (inhibit-eol-conversion  t)
        status)
    (unless (= (setq status (call-process-region (point-min) (point-max)
                                                 "gzip" t t nil "-d")) 0)
      (error "Could not decompress PLT package: gzip process status %s"
             status)))

  ;; Move past the "PLT" cookie, and the two sexp forms.
  (goto-char (point-min))
  (unless (looking-at "PLT")
    (error "This does not appear to be a PLT package file."))
  (goto-char (match-end 0))
  (forward-list 2)
  (quack-skip-whitespace-to-nonblank-line-beginning)
  (quack-make-face-ovlext (point-min) (point) 'quack-pltfile-prologue-face)

  ;; Process the buffer contents.
  (let ((standard-input (current-buffer)))

    (while (not (eobp))
      (let ((step-beg (point)))
        ;; TODO: This read will fail if we just had whitespace at the end of
        ;;       the file, which it shouldn't, but maybe we should check, just
        ;;       in case.
        (let ((sym (read)))
          (unless (symbolp sym)
            (error "Expected a symbol, but saw: %S" sym))
          (cond

           ((eq sym 'dir)
            (forward-list)
            (quack-skip-whitespace-to-nonblank-line-beginning)
            (quack-make-face-ovlext step-beg
                                    (point)
                                    'quack-pltfile-dir-face))

           ((memq sym '(file file-replace))
            (forward-list)
            (let ((size (read)))
              (unless (and (integerp size) (>= size 0))
                (error "Expected a file size, but saw: %S" size))
              (unless (looking-at "[ \t\r\n\f]*\\*")
                (error "Expected a `*' after file size."))
              (goto-char (match-end 0))

              ;; Fontify the file header.
              (quack-make-face-ovlext step-beg
                                      (1- (point))
                                      'quack-pltfile-file-face)

              ;; Hide the file contents asterisk.
              (quack-make-hiding-ovlext (1- (point)) (point))

              ;; Set the coding region for the content.
              (let* ((content-beg (point))
                     (content-end (+ content-beg size))
                     (cs          (detect-coding-region content-beg
                                                        content-end)))
                (goto-char content-end)
                (when (listp cs)
                  (setq cs (car cs)))
                (unless (eq cs 'undecided)
                  (cond ((eq cs 'undecided-dos)  (setq cs 'raw-text-dos))
                        ((eq cs 'undecided-mac)  (setq cs 'raw-text-mac))
                        ((eq cs 'undecided-unix) (setq cs 'raw-text-unix)))
                  (decode-coding-region content-beg content-end cs))
                ;; TODO: XEmacs 21 `decode-coding-region' seems to lose the
                ;;       point position.  This is disconcerting, since the
                ;;       point semantics under coding system changes do not
                ;;       currently seem to be well-specified, so resetting the
                ;;       point here *might* not always be the right thing to
                ;;       do.  Verify.
                (quack-when-xemacs
                 (goto-char content-end)))))

           (t (error "Expected `dir', `file', or `file-replace', but saw: %S"
                     sym)))))))

  ;; Return point to top of buffer.
  (goto-char (point-min)))

;; The rest of this file except for the `provide' form is TODO comments.

;; TODO: Add tool bar support later.
;;
;; (defvar quack-toolbarimage-width  24)
;; (defvar quack-toolbarimage-height 24)
;;
;; (defun quack-create-image (&rest args)
;;   (if (and quack-gnuemacs-p (>= emacs-major-version 21))
;;       (apply 'create-image args)
;;     nil))
;;
;; (defun quack-make-toolbarimage (&rest lines)
;;   ;; TODO: We really should make an efficient function to print N spaces
;;   ;;       or to return a string of N spaces.  Or at least keep 1-2
;;   ;;       strings for the left and right padding here, which will
;;   ;;       usually be the same for the duration of this function.
;;   (quack-create-image
;;    (let* ((lines-count (length lines))
;;           (blank-line  (make-string quack-toolbarimage-width 32)))
;;      (and (> lines-count quack-toolbarimage-height) (quack-internal-error))
;;      (with-output-to-string
;;        (princ "/* XPM */\nstatic char *magick[] = {\n")
;;        ;;(princ "/* columns rows colors chars-per-pixel */\n")
;;        (princ (format "\"%d %d 5 1\",\n"
;;                       quack-toolbarimage-width quack-toolbarimage-height))
;;        (princ "\". c #f0f0f0\",\n")
;;        (princ "\"@ c #0f0f0f\",\n")
;;        (princ "\"g c #00b000\",\n")
;;        (princ "\"r c #d00000\",\n")
;;        (princ "\"  c None\",\n")
;;        ;;(princ "/* pixels */\n")
;;        (let ((line-num 0))
;;          (mapcar (function
;;                   (lambda (line)
;;                     (princ "\"")
;;                     (if line
;;                         (let* ((c (length line))
;;                                (l (/ (- quack-toolbarimage-width c) 2)))
;;                           (and (> c quack-toolbarimage-width)
;;                                (quack-internal-error))
;;                           (princ (make-string l 32))
;;                           (princ line)
;;                           (princ (make-string (- quack-toolbarimage-width
;;                                                  c l)
;;                                               32)))
;;                       (princ blank-line))
;;                     (if (< (setq line-num (1+ line-num))
;;                            quack-toolbarimage-height)
;;                         (princ "\",\n")
;;                       (princ "\"\n"))))
;;                  (let ((rows-before (/ (- quack-toolbarimage-width
;;                                           lines-count)
;;                                        2)))
;;                    `(,@(make-list rows-before nil)
;;                        ,@lines
;;                        ,@(make-list (- quack-toolbarimage-height
;;                                        lines-count rows-before)
;;                                     nil)))))
;;        (princ "};\n")))
;;    'xpm t))
;;
;; (defvar quack-tbi-evalbuf
;;   (quack-make-toolbarimage
;;    "@@@@@@@@@@          "
;;    "@........@@         "
;;    "@........@.@   ggg  "
;;    "@........@..@  ggg  "
;;    "@........@@@@@ ggg  "
;;    "@............@ ggg  "
;;    "@..@@........@ ggg  "
;;    "@...@@.......@ ggg  "
;;    "@....@@......@ ggg  "
;;    "@.....@@.....@ ggg  "
;;    "@....@@@@....@ ggg  "
;;    "@...@@..@@...@ ggg  "
;;    "@..@@....@@..@ ggg  "
;;    "@............@ ggg  "
;;    "@@@@@@@@@@@@@@ ggg  "
;;    "               ggg  "
;;    "             ggggggg"
;;    "              ggggg "
;;    "               ggg  "
;;    "                g   "))
;;
;; (defvar quack-tbi-adoc
;;   (quack-make-toolbarimage
;;    "@@@@@@@@@@    "
;;    "@........@@   "
;;    "@........@.@  "
;;    "@........@..@ "
;;    "@........@@@@@"
;;    "@...@@@......@"
;;    "@..@@@@@@....@"
;;    "@..@....@@...@"
;;    "@...@@@.@@...@"
;;    "@..@@@@@@@...@"
;;    "@..@@...@@...@"
;;    "@..@@..@@@...@"
;;    "@...@@@@.@@..@"
;;    "@............@"
;;    "@@@@@@@@@@@@@@"))
;;
;; (defvar quack-tbi-manual
;;   (quack-make-toolbarimage
;;    "@@@@@@@@@@    "
;;    "@........@@   "
;;    "@........@.@  "
;;    "@........@..@ "
;;    "@........@@@@@"
;;    "@............@"
;;    "@..@@.@.@@...@"
;;    "@..@@@@@@@@..@"
;;    "@..@@.@@.@@..@"
;;    "@..@@.@@.@@..@"
;;    "@..@@.@@.@@..@"
;;    "@..@@.@@.@@..@"
;;    "@..@@.@@.@@..@"
;;    "@............@"
;;    "@@@@@@@@@@@@@@"))
;;
;; (defvar quack-tbi-manuallookup
;;   (quack-make-toolbarimage
;;    "@@@@@@@@@@          "
;;    "@........@@         "
;;    "@........@.@        "
;;    "@........@..@       "
;;    "@........@@@@@      "
;;    "@............@      "
;;    "@..@@.@@@@@@@@@@    "
;;    "@...@@@........@@   "
;;    "@....@@........@.@  "
;;    "@.....@........@..@ "
;;    "@....@@........@@@@@"
;;    "@...@@@............@"
;;    "@..@@.@..@@.@.@@...@"
;;    "@.....@..@@@@@@@@..@"
;;    "@@@@@@@..@@.@@.@@..@"
;;    "      @..@@.@@.@@..@"
;;    "      @..@@.@@.@@..@"
;;    "      @..@@.@@.@@..@"
;;    "      @..@@.@@.@@..@"
;;    "      @............@"
;;    "      @@@@@@@@@@@@@@"))
;;
;; (defvar quack-tbi-stop
;;   (quack-make-toolbarimage
;;    "    @@@@@    "
;;    "  @@rrrrr@@  "
;;    " @rrrrrrrrr@ "
;;    " @rrrrrrrrr@ "
;;    "@rr@@rrr@@rr@"
;;    "@rrr@@r@@rrr@"
;;    "@rrrr@@@rrrr@"
;;    "@rrr@@r@@rrr@"
;;    "@rr@@rrr@@rr@"
;;    " @rrrrrrrrr@ "
;;    " @rrrrrrrrr@ "
;;    "  @@rrrrr@@  "
;;    "    @@@@@    "))
;;
;; (defun quack-install-tool-bar ()
;;   (require 'tool-bar)
;;   (let ((map (make-sparse-keymap)))
;;
;;     (quack-define-key-after map [quack-load-file]
;;                             `(menu-item "quack-evalbuffer" scheme-load-file
;;                                         :image ,quack-tbi-evalbuf
;;                                         :help  "Load File"))
;;
;;     (quack-define-key-after map [quack-alpha]
;;                             `(menu-item "quack-alpha" quack-alpha
;;                                         :image ,quack-tbi-adoc
;;                                         :help  "alpha"))
;;
;;     (quack-define-key-after map [quack-manual]
;;                             `(menu-item "quack-manual" quack-manual
;;                                         :image ,quack-tbi-manual
;;                                         :help  "View Manual"))
;;
;;     (quack-define-key-after map [quack-view-keyword-docs]
;;                             `(menu-item "quack-view-keyword-docs"
;;                                         quack-view-keyword-docs
;;                                         :image ,quack-tbi-manuallookup
;;                                         :help  "View Keyword Docs"))
;;
;;     (quack-define-key-after map [quack-stop]
;;                             `(menu-item "quack-stop" quack-stop
;;                                         :image ,quack-tbi-stop
;;                                         :help  "Stop"))
;;
;;     (set (make-local-variable 'tool-bar-map) map)))

;; TODO: Extend `scheme-imenu-generic-expression' for PLT-specific definition
;;       forms and for definitions within modules.

;; TODO: Clickable URLs
;;
;; (defvar quack-url-keymap)
;; 
;; (setq quack-url-keymap (make-sparse-keymap))
;; (define-key quack-url-keymap "\r" 'quack-browse-overlaid-url)
;; (define-key quack-url-keymap "q" 'quack-browse-overlaid-url)
;; 
;; (defun quack-make-url-overlay (beg end &optional url)
;;   (let ((ovl (make-overlay beg end nil t)))
;;     (overlay-put ovl 'face      'underline)
;;     (overlay-put ovl 'local-map 'quack-url-keymap)
;;     (overlay-put ovl 'help-echo "Press RET to browse this URL.")
;;     (overlay-put ovl 'quack-url
;;                      (or url (buffer-substring-no-properties beg end)))
;;     ovl))
;; 
;; (defun quack-insert-url (url)
;;   (let* ((beg (point)))
;;     (insert url)
;;     (quack-make-url-overlay beg (point))))
;; 
;; (defun quack-overlaid-url-at-point (&optional pt)
;;   (let ((overlays (overlays-at (or pt (point))))
;;         (url      nil))
;;     (while overlays
;;       (setq overlays (if (setq url (overlay-get (car overlays) 'quack-url))
;;                          (cdr overlays)
;;                        '())))
;;     url))
;; 
;; (defun quack-browse-overlaid-url (pt)
;;   ;; Dehydration.
;;   (interactive "d")
;;   (quack-browse-url (quack-overlaid-url-at-point pt)))

;; TODO: Possible Future Inferior Process I/O Stuff.  Make encoding with
;;       inferior process disambiguate REPL values, port output, error info,
;;       etc.  Start of code commented out below.  This may require rewriting
;;       chunks of `cmuscheme' and `comint'.
;;
;;       Try to use ELI protocol first.  http://www.cliki.net/ELI
;;
;; (defface quack-output-face
;;   '((((class color)) (:foreground "purple4" :background "lavender"))
;;     (t               (:inverse-video t)))
;;   "Face used for..."
;;   :group 'quack)
;;
;; (defface quack-value-face
;;   '((((class color)) (:foreground "blue4" :background "light sky blue"))
;;     (t               (:inverse-video t)))
;;   "Face used for..."
;;   :group 'quack)
;;
;; Escape Codes:
;;     REPL State:
;;         R  repl read begin
;;         r  repl read end
;;         E  repl eval begin
;;         e  repl eval end
;;         P  repl print begin
;;         p  repl print end
;;     Stream Change:
;;         O  output stream
;;         E  error stream
;;     Error Info?
;;
;; (defconst quack-mzscheme-init-string
;;   (let ((print-length nil)
;;         (print-level  nil))
;;     (prin1-to-string
;;      '(let ((o (current-output-port))
;;             (i (current-input-port))
;;             (e (current-eval)))
;;         ;; TODO: Define custom escaping output and error ports here.
;;         (current-prompt-read
;;          (lambda ()
;;            (display "\eR" o)
;;            (begin0 (read-syntax "quack-repl" i)
;;                    (display "\er" o))))
;;         (current-eval
;;          (lambda (n)
;;            (display "\eE" o)
;;            (begin0 (e n)
;;                    (display "\ee" o))))
;;         (current-print
;;          (lambda (n)
;;            (display "\eP" o)
;;            (begin0 (print n o)
;;                    (display "\ep" o))))))))
;;
;; In `quack' function, after call to `run-scheme':
;;
;; (add-hook 'comint-preoutput-filter-functions
;;           'quack-comint-preoutput-filter-func)
;; (comint-send-string (scheme-proc) quack-mzscheme-init-string)
;; (comint-send-string (scheme-proc) "\n")

;; TODO: If we do that, then add pretty-printing of REPL results.

;; TODO: Maybe provide utilities for converting to/from PLT-style
;;       square-bracket paren conventions.

;; TODO: Populate abbrevs table from keywords extracted from manuals, and from
;;       definitions in current buffer.  Or maybe query running MzScheme
;;       process for bound symbols.

;; TODO: Maybe use `compile-zos' to do error-checking for PLT (look up person
;;       to credit with idea of using that to get more warnings).  Need to know
;;       more about a particular Scheme implementation than just the command
;;       line to start its REPL, though.

;; TODO: Perhaps put some initialization code that depends on user's custom
;;       settings into after-init-hook.  See if this works in XEmacs.

;; TODO: Set `interpreter-mode-alist' based on interpreter list.

;; TODO: "I think it would be good if the quack menu showed up only when emacs
;;        was in Scheme mode."

;; TODO: Support this:
;;
;;       * Added 'addon-dir for `find-system-path':
;;       Unix: "~/.plt-scheme"
;;       Windows: "PLT Scheme" in the user's Application Data folder.
;;       Mac OS X: "~/Library/PLT Scheme"
;;       Mac OS Classic: "PLT Scheme" in the preferences folder.
;;
;;       The version string for "~/.plt-scheme//collects/" might be:
;;       mzscheme -mqe '(begin (display (version)) (exit))'
;;       Double-check PLT source first.

;; TODO: Add autoindenting to inferior Scheme buffer when pressing RET on an
;;       incomplete sexp -- iff we can do this reliably enough.

;; TODO: When tidying and point is within a series of multiple blank lines that
;;       are reduced to a single blank line, leave point at the beginning of
;;       the single blank line.

;; TODO: Riastradh says: Do you suppose you could add a feature to Quack that
;;       indents lists beginning with symbols of the form WITH-...  &
;;       CALL-WITH-... as if their SCHEME-INDENT-FUNCTION property were DEFUN?

;; TODO: Matt Dickerson asks " Also, the command history appears to be based on
;;       newlines -- I work with blocks of code in the REPL and would like C-p
;;       to give me the last block, not the last line of the previous block."

;; TODO: Maybe get appropriate PLT collection path from the default for
;;       whatever "mzscheme" executable is picked up.
;;
;; mzscheme -emq '(begin (write (current-library-collection-paths)) (exit 0))'
;; ("/home/neil/collects" "/home/neil/.plt-scheme/208/collects"
;;  "/usr/lib/plt/collects")

;; TODO: Bind M-[ to quack-insert-parentheses

;; TODO: Peter Barabas reports that `quack-global-menu-p' set to nil doesn't
;; disable the menu.

;; TODO: Way to get default collects directories.  From Matthew Flatt,
;; 2006-04-22:
;; 
;; env PLTCOLLECTS="" mzscheme -mvqe '(printf "~s\n" (map path->string 
;; (current-library-collection-paths)))'

;; TODO: Have key binding to insert "lambda" (for use with pretty-lambda).
;; Suggested by Olwe Bottorff on 2006-04-20.

;; TODO: Jerry van Dijk writes: "I would like to try out quack, but I do not
;; like its menu constantly on the main menu bar (as I use emacs for a lot of
;; things). Unfortunately sofar quack has bravely defied all my attempts to
;; remove it. From desecting the customize option to adding (define-key
;; global-map [menu-bar quack] nil)"

;; TODO: We could do this:
;;
;; mzscheme -m -e "(begin (display #\') (write (map path->string (current-library-collection-paths))) (newline) (exit))"
;; '("/home/neil/collects"
;;   "/home/neil/.plt-scheme/360/collects"
;;   "/usr/lib/plt/collects")

;; emacs22  -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
;; emacs21  -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
;; emacs20  -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
;; xemacs21 -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc

;; End:

(provide 'quack)

;; quack.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/projects.el0000775000000000000000000002313312230377266021424 0ustar  ;;; projects.el -- Project-based buffer name management

;; Copyright 1998 Naggum Software
;; Copyright 2003 Peter S Galbraith 

;; Author: Erik Naggum 
;; Maintainer: Peter S Galbraith 
;;  Erik Naggum died on June 17, 2009.  I will therefofre maintain this
;;  since it was already packaged in Debian, but contact me if you would
;;  like to take over.  - Peter
;; Keywords: internal

;; This file is not part of GNU Emacs, but distributed under the same
;; conditions as GNU Emacs, and is useless without 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 2, 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Managing a large number of buffers that visit files in many directories
;; (such as both local and remote copies of sources) can be confusing when
;; there are files with similar or even identical names and the buffers end
;; up being named foobar.cl<19> or like unintuitiveness.  This package
;; introduces the concept of PROJECT ROOTS that allow the programmer to
;; define what looks suspiciously like logical pathname hosts from Common
;; Lisp and get abbreviated yet meaningful buffer names in the modeline.

;; Commands include PROJECT-ADD, which takes a project name and a directory
;; (which conveniently defaults to the current directory), PROJECT-REMOVE
;; (which completes on existing projects), and PROJECT-LIST, which lists the
;; current projects in a rudimentary table.  PROJECT-UPDATE-BUFFER-NAMES is
;; called automatically when either PROJECT-ADD or PROJECT-REMOVE changes
;; the project list, but may also be called by the user as a command.

;; Variables include PROJECT-ROOT-ALIST, which contains the list of current
;; projects and their root directories, and two variables that control the
;; naming of buffers: PROJECT-BUFFER-NAME-DIRECTORY-LIMIT, the uppper limit
;; on the number of characters in the last few directory elements in the
;; pathname that makes up the buffer name and
;; PROJECT-BUFFER-NAME-DIRECTORY-PREFIX, the string prepended to buffer
;; names that would be too long.

;; Internal functions include PROJECT-BUFFER-NAME, which computes the
;; buffer name from the filename argument, PROJECT-ROOT-ALIST, which
;; computes a sorted list of projects on their directories and maintains a
;; cache because this operation is expensive, and a redefinition of the
;; function CREATE-FILE-BUFFER, which is called to create new file-visiting
;; buffers.  Note that the latter may still produce ..., if truly
;; identical buffer names are requested.  This may happen if you call dired
;; on a filename and then visit the same file.  Use C-x C-v M-p instead.

;; Loading this file is sufficient to install the package.
;; Reloading has no effect.

;;; History:

;; 2003-10-27 Peter S Galbraith 
;;
;;  I tried to contact the author but his host is down.  I like the concept
;;  of prefixing certain buffer names with a project name, but not renaming
;;  all unrelated buffers with the full directory path.  This breaks MH-E
;;  mail folder names for example.  So I'm introducing the variable
;;  `project-rename-all-buffers' with a default of nil.  You may customize
;;  this to obtain the old behaviour.
;;
;;  In addition, I am renaming commands:
;;
;;    `add-project'    to `project-add'
;;    `remove-project' to `project-remove'.
;;    `list-projects'  to `project-list'.
;;    `update-buffer-names' to `project-update-buffer-names'
;;
;;  variables (also made into defcustoms):
;;
;;    `buffer-name-directory-limit' to `project-buffer-name-directory-limit'
;;    `buffer-name-directory-prefix' to `project-buffer-name-directory-prefix'

;;; Code:

(require 'cl)

(provide 'projects)

(defgroup projects nil
  "Project-based buffer name management."
  :group 'convenience)

(defcustom project-rename-all-buffers nil
  "*Whether to rename buffer not belonging to a project."
  :type 'boolean
  :group 'projects)

(defcustom project-buffer-name-directory-limit 20
  "*Directories in buffer names are attempted kept shorter than this."
  :type 'integer
  :group 'projects)

(defcustom project-buffer-name-directory-prefix "<"
  "*String to prepend to an abbreviated buffer name."
  :type 'string
  :group 'projects)

;; External symbols

(defvar project-root-alist nil
  "Alist of projects and their root directories.
The key should be a (short) project name.
The value should be the project's root directory.
Multiple projects in the same hierarchy is handled correctly.")

;;;###autoload
(defun project-add (name directory)
  "Add the project named NAME with root directory DIRECTORY."
  (interactive "sName of project: \nDDirectory of project %s: ")
  (push (cons name directory) project-root-alist)
  (message "Project `%s' maps to `%s'" name directory)
  (project-update-buffer-names))

(defun project-remove (name)
  "Remove the project named NAME."
  (interactive
   (list (completing-read "Name of project: " project-root-alist nil t)))
  (setf project-root-alist
    (remove* name project-root-alist :key #'car :test #'equal))
  (project-update-buffer-names))

(defun project-list (&optional sort-by-root)
  "List all projects sorted by project name.
If optional argument SORT-BY-ROOT is true, sort by project root, instead."
  (interactive "P")
  (let* ((project-list
	  (sort* (copy-list (project-root-alist))
		 #'string< :key (if sort-by-root #'cdr #'car)))
	 (longest
	  (loop for (name) in project-list maximize (length name))))
    (if project-list
      (with-output-to-temp-buffer "*Help*"
	(princ "Current projects and their root directories:\n\n")
	(loop for (name . dir) in project-list do
	      (princ name)
	      (princ ":")
	      (princ (make-string (- (max 6 longest) -2 (length name)) ?\ ))
	      (princ (file-truename dir))
	      (terpri)))
      (message "There are no projects."))))

(defun project-update-buffer-names (&rest buffers)
  "Update the name of the indicated BUFFERS.
Interactively, or if no buffers are given, the names of all file-visiting
buffers are updated according to the new value of PROJECT-ROOT-ALIST."
  (interactive)
  (dolist (buffer (or buffers (buffer-list)))
    (with-current-buffer buffer
      (when buffer-file-name
	(setf (buffer-name) (project-buffer-name buffer-file-name))))))

;; Internal symbols

(defun project-root-alist ()
  "Return possibly updated cache from PROJECT-ROOT-ALIST."
  (symbol-macrolet			;fake closures badly
      ((project-alist    (get 'project-root-alist 'project-alist))
       (project-internal (get 'project-root-alist 'project-internal)))
    (if (equal project-alist project-root-alist)
      project-internal
      (setq project-internal
	(sort* (loop for (name . dir)
		     in (setq project-alist project-root-alist)
		     collect (cons name (file-name-as-directory
					 (file-truename dir))))
	      (lambda (f1 f2)
		(or (> (length f1) (length f2))
		    (string< f1 f1)))
	      :key #'cdr)))))

(defun project-buffer-name (filename)
  "Return the name of a buffer based on FILENAME and current projects.
If the file is under a project hierarchy, as determined by the variable
PROJECT-ROOT-ALIST, prefix its project-relative name with the name of the
project.  Otherwise, name the buffer like the filename, but limit the
directory to PROJECT-BUFFER-NAME-DIRECTORY-LIMIT characters by chopping
off from the front and prepending PROJECT-BUFFER-NAME-DIRECTORY-PREFIX."
  (block name
    (let* ((truename (file-truename (if (file-directory-p filename)
                                        (file-name-as-directory filename)
				      filename))))
      (loop for (name . dir) in (project-root-alist)
	    when (and (>= (length truename) (length dir))
		      (string= dir (substring truename 0 (length dir))))
	    do (return-from name
		 (concat name ":" (substring truename (length dir)))))
      (cond
       ((not project-rename-all-buffers)
        (let ((lastname (file-name-nondirectory filename)))
          (if (string= lastname "")
              (setq lastname filename))
          lastname))
       (t
        ;; Old behaviour
        ;; may not need to abbreviate if directory is short enough
        (when (<= (position ?/ (abbreviate-file-name truename) :from-end t)
                  project-buffer-name-directory-limit)
          (return-from name (abbreviate-file-name truename)))
        ;; keep directories shorter than PROJECT-BUFFER-NAME-DIRECTORY-LIMIT.
        ;; prepend PROJECT-BUFFER-NAME-DIRECTORY-PREFIX to abbreviated names.
        (let* ((final (position ?/ truename :from-end t))
               (start (- final project-buffer-name-directory-limit))
               (first (or (position ?/ truename :start start :end final)
                          (position ?/ truename :end start :from-end t)
                          start)))
          (concat project-buffer-name-directory-prefix
                  (subseq truename first))))))))

;; This overrides a function in EMACS:lisp/files.el

(defun create-file-buffer (filename)
  "Create a suitably named buffer for visiting FILENAME, and return it.
See PROJECT-BUFFER-NAME for more information."
  (generate-new-buffer (project-buffer-name filename)))

;;; projects.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/emacs-goodies-el.el0000775000000000000000000002357712230377265022723 0ustar  ;;; emacs-goodies-el.el --- startup file for the emacs-goodies-el package

;;; Commentary:
;;
;; This file is loaded from /etc/emacs/site-start.d/50emacs-goodies-el.el

;;; History:
;;
;; 2009-02-22 Peter Galbraith
;;  - Replace $ by \\' in auto-mode-alist entries (Closes: #570293)
;; 2006-11-26 - Ramkumar R.
;;  - Obey `emacs-goodies-el-defaults' for xrdb-mode.
;; 2003-06-14 - Peter Galbraith
;;  - Delete autoloads that can be generated automatically.
;; 2003-05-14 - Peter Galbraith
;;  - Created from 50emacs-goodies-el.el contents.

;;; Code:

(defgroup emacs-goodies-el nil
  "Debian emacs-goodies-el package customization."
  :group 'convenience)

(require 'emacs-goodies-loaddefs)
(require 'emacs-goodies-custom)

(defcustom emacs-goodies-el-defaults nil
  "Whether default settings are chosen conservatively or aggressively.
non-nil means aggressive.
Setting to aggressive will enable features that supercede Emacs defaults."
  :type '(radio (const :tag "conservative" nil)
                (const :tag "aggressive" t))
  :link '(custom-manual "(emacs-goodies-el)Top")
  :group 'emacs-goodies-el)

;; align-string.el
(autoload 'align-string "align-string"
  "Align first occurrence of REGEXP in each line of region."
  t)
(autoload 'align-all-strings "align-string"
  "Align all occurrences of REGEXP in each line of region."
  t)

;; apache-mode.el
(add-to-list 'auto-mode-alist '("apache2\\.conf\\'"  . apache-mode))

;; clipper.el
(autoload 'clipper-create "clipper" "Create a new 'clip' for use within Emacs."
  t)
(autoload 'clipper-delete "clipper" "Delete an existing 'clip'." t)
(autoload 'clipper-insert "clipper"
  "Insert a new 'clip' into the current buffer."
  t)
(autoload 'clipper-edit-clip "clipper" "Edit an existing 'clip'." t)

;; cvs-mode.el
(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
(autoload 'csv-mode "csv-mode"
  "Major mode for editing comma-separated value files." t)

;; cyclebuffer.el
(autoload 'cyclebuffer-forward "cyclebuffer"
  "Cycle buffer forward."
  t)
(autoload 'cyclebuffer-backward "cyclebuffer"
  "Cycle buffer backward."
  t)

;; dict.el
(autoload 'dict "dict" "Lookup a word in the dictionary" t)
(autoload 'dict-region "dict" "Lookup a region in the dictionary" t)

;; ff-paths.el
(defcustom ff-paths-install emacs-goodies-el-defaults
  "Whether to setup ff-paths for use.
find-file-using-paths searches certain paths to find files."
  :type 'boolean
  :set (lambda (symbol value)
         (set-default symbol value)
         (when value
           (ff-paths-install)))
  :load 'ff-paths
;;  :require 'ff-paths
  :group 'emacs-goodies-el
  :group 'ff-paths)

(defcustom ff-paths-use-ffap emacs-goodies-el-defaults
  "Whether to setup ffap for use.

Usually packages don't advertise or try to setup other packages, but
ff-paths works well in combination with ffap (Find FILENAME, guessing a
default from text around point) and so I recommend it here.

find-file-using-paths searches certain paths to find files."
  :type 'boolean
  :set (lambda (symbol value)
         (set-default symbol value)
         (when value
           (require 'ffap)
           (ff-paths-in-ffap-install)))
;;  :require 'ff-paths
  :load 'ff-paths
  :group 'emacs-goodies-el
  :group 'ff-paths)

;; filladapt
(autoload 'turn-on-filladapt-mode "filladapt"
  "Unconditionally turn on Filladapt mode in the current buffer."
  t)

(defcustom filladapt-turn-on-mode-hooks nil
  "*List of hooks for which to turn-on filladapt.
Filladapt works well with any language that uses comments that
start with some character sequence and terminate at end of line.
So it is good for Postscript, Lisp, Perl, C++ and shell modes.
It's not good for C mode because C's comments are multiline."
  :type '(set (const text-mode-hook)
              (const awk-mode-hook)
              (const lisp-mode-hook)
              (const emacs-lisp-mode-hook)
              (const perl-mode-hook))
  :set (lambda (symbol value)
         ;; Remove old values since user may have deleted entries
         (if (and (boundp 'filladapt-mode-hooks) filladapt-mode-hooks)
             (mapcar (lambda (hook) (remove-hook hook 'turn-on-filladapt-mode))
                     filladapt-mode-hooks))
         (set-default symbol value)
         ;; Set entries selected by the user.
         (mapcar (lambda (hook) (add-hook hook 'turn-on-filladapt-mode))
                 value))
  :load 'filladapt
  :group 'emacs-goodies-el
  :group 'filladapt)

;; highlight-completion.el
(autoload 'highlight-completion-mode "highlight-completion"
  "Activate highlight-completion."
  t)

;; highlight-current-line.el - compatibility
(autoload 'highlight-current-line-on "highlight-current-line"
  "Switch highlighting of cursor-line on/off globally."
  t)

;; home-end.el
(defvar home-end-end-enable nil
  "Whether `home-end-enable' was activated.
Stores the value of the prior `end' keybinding.")
(defvar home-end-home-enable nil
  "Whether `home-end-enable' was activated.
Stores the value of the prior `home' keybinding.")
(defcustom home-end-enable emacs-goodies-el-defaults
  "*Define [home] and [end] keys to act differently when hit 1, 2 or 3 times."
  :type 'boolean
  :set (lambda (symbol value)
         (set-default symbol value)
         (cond
          (value
           (setq home-end-end-enable (key-binding [end])
                 home-end-home-enable (key-binding [home]))
           (global-set-key [end]  'home-end-end)
           (global-set-key [home] 'home-end-home))
          (t
           (if home-end-end-enable
               (global-set-key [end] home-end-end-enable))
           (if home-end-home-enable
               (global-set-key [home] home-end-home-enable)))))
  :load 'home-end
  :group 'emacs-goodies-el)

;; keydef.el
(autoload 'keydef "keydef"
  "Define the key sequence SEQ, written in kbd form, to run CMD."
  t)

;; keywiz.el
(autoload 'keywiz "keywiz"
  "Start a key sequence quiz."
  t)

;; map-lines.el
(autoload 'map-lines "map-lines"
  "Map COMMAND over lines matching REGEX."
  t)

;; maplev
(autoload 'maplev-mode "maplev" "Maple editing mode" t)
(autoload 'cmaple      "maplev" "Start maple process" t)
(add-to-list 'auto-mode-alist '("\\.mpl\\'" . maplev-mode))

;; matlab
(defcustom matlab-auto-mode nil
  "*Enter matlab-mode when editing .m files.
Technically, this adjusts the `auto-mode-list' when set.
To unset, you will have to restart Emacs."
  :type 'boolean
  :set (lambda (symbol value)
         (set-default symbol value)
         (cond
          (value
           (add-to-list 'auto-mode-alist '("\\.m\\'" . matlab-mode)))))
  :load 'matlab
  :group 'emacs-goodies-el
  :require 'matlab)

;; minibuf-electric.el
(defcustom minibuffer-electric-file-name-behavior nil
  "*If non-nil, slash and tilde in certain places cause immediate deletion.
These are the same places where this behavior would occur later on anyway,
in `substitute-in-file-name'."
  :type 'boolean
  :require 'minibuf-electric
  :load 'minibuf-electric
  :group 'emacs-goodies-el
  :group 'minibuffer)

;; mutt-alias.el
(autoload 'mutt-alias-insert "mutt-alias"
  "Insert the expansion for ALIAS into the current buffer."
  t)
(autoload 'mutt-alias-lookup "mutt-alias"
  "Lookup and display the expansion for ALIAS."
  t)

;; muttrc-mode.el
(add-to-list 'auto-mode-alist '("muttrc\\'" . muttrc-mode))


;; pod-mode.el
(add-to-list 'auto-mode-alist '("\\.pod\\'" . pod-mode))

;; rfcview
(add-to-list 'auto-mode-alist
             '("/rfc[0-9]+\\.txt\\(\\.gz\\)?\\'" . rfcview-mode))

;; session.el
(autoload 'session-initialize "session"
  "Initialize package session and read previous session file.
Setup hooks and load `session-save-file', see `session-initialize'.  At
best, this function is called at the end of the Emacs startup, i.e., add
this function to `after-init-hook'."
  t)

;; setnu.el
(autoload 'setnu-mode "setnu"
  "Toggle setnu-mode."
  t)
(autoload 'turn-on-setnu-mode "setnu"
  "Turn on setnu-mode."
  nil)

;; slang-mode.el
(setq auto-mode-alist
      (append '(("\\.sl\\'" . slang-mode)) auto-mode-alist))

;; todoo.el
(when (not (featurep 'xemacs))
  (autoload 'todoo "todoo"
    "TODO Mode."
    t)
  (autoload 'todoo-mode "todoo"
    "TODO Mode"
    t)
  (add-to-list 'auto-mode-alist '("TODO\\'" . todoo-mode)))

;; toggle-option.el
(autoload 'toggle-option "toggle-option"
  "Easily toggle frequently toggled options."
  t)

;; upstart-mode.el
(when (not (featurep 'xemacs))
  (autoload 'upstart-mode "upstart-mode"
    "major mode for .upstart files."
    t)
  (add-to-list 'auto-mode-alist '("\\.upstart\\'" . upstart-mode)))

;; xrdb-mode.el

(defun xrdb-mode-setup-auto-mode-alist ()
  (add-to-list 'auto-mode-alist '("\\.Xdefaults\\'" . xrdb-mode))
  (add-to-list 'auto-mode-alist '("\\.Xenvironment\\'". xrdb-mode))
  (add-to-list 'auto-mode-alist '("\\.Xresources\\'". xrdb-mode))
  (add-to-list 'auto-mode-alist '("\\.ad\\'". xrdb-mode))
  (add-to-list 'auto-mode-alist '("/app-defaults/". xrdb-mode))
  (add-to-list 'auto-mode-alist '("/Xresources/". xrdb-mode)))

(defcustom xrdb-mode-setup-auto-mode-alist
  (or
   ;; Check if conf-xdefaults-mode is present
   (not (fboundp 'conf-xdefaults-mode))
   ;; Check if default setup provides bindings for conf-xdefaults-mode
   (< emacs-major-version 22)
   (featurep 'xemacs)
   ;; Check if the user wants settings to be clobbered
   emacs-goodies-el-defaults)
  "Whether to setup mode-alists for xrdb mode.

Newer versions of Emacs have a conf-xdefaults-mode which provides
this functionality. `xrdb' still has some features (like
electricity) which are absent in that mode. Setting this to
non-nil clobbers the default bindings in such cases.

This variable defaults to t for older emacsen and the value
`emacs-goodies-el-defaults' for newer ones.

Customizing this variable might require restarting emacs for the
effects to take effect."
  :type 'boolean
  :set (lambda (symbol value)
         (set-default symbol value)
         (when value
           (xrdb-mode-setup-auto-mode-alist)))
  :group 'emacs-goodies-el
  :group 'xrdb)

(provide 'emacs-goodies-el)

;;; emacs-goodies-el.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/eproject-extras.el0000664000000000000000000002647112230377265022716 0ustar  ;;; eproject-extras.el --- various utilities that make eproject more enjoyable

;; Copyright (C) 2009  Jonathan Rockway

;; Author: Jonathan Rockway 
;; Keywords: eproject

;; 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 .

;;; Commentary:

;; Some of this stuff used to be in eproject "core", but it is a bit
;; bloated, and not strictly necessary.  So now it lives here, leaving
;; the eproject core pristine and minimal.

;;; Code:

(require 'eproject)
(require 'cl)
(require 'iswitchb)
(require 'ibuffer)
(require 'ibuf-ext)

;; support for visiting other project files
(defalias 'eproject-ifind-file 'eproject-find-file)  ;; ifind is deperecated

(defun eproject--shorten-filename (filename)
  "Shorten FILENAME in the context of the current project.
Uses the function provided by the `:file-name-map' project attribute.

The default implementation just makes the filename relative to
the project root."
  (cons (funcall (eproject-attribute :file-name-map)
                 (eproject-root)
                 (file-relative-name filename (eproject-root)))
        filename))

;;;###autoload
(defun eproject-find-file ()
  "Present the user with a list of files in the current project.
to select from, open file when selected."
  (interactive)
  (find-file (eproject--icomplete-read-with-alist
              "Project file: "
              (mapcar #'eproject--shorten-filename (eproject-list-project-files)))))

(defun eproject--completing-read (prompt choices)
  "Use completing-read to do a completing read."
  (completing-read prompt choices nil t))

(defun eproject--icompleting-read (prompt choices)
  "Use iswitchb to do a completing read."
  (let ((iswitchb-make-buflist-hook
         (lambda ()
           (setq iswitchb-temp-buflist choices))))
    (unwind-protect
        (progn
          (when (not iswitchb-mode)
            (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
          (iswitchb-read-buffer prompt nil t))
      (when (not iswitchb-mode)
        (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))

(defun eproject--ido-completing-read (prompt choices)
  "Use ido to do a completing read."
  (ido-completing-read prompt choices nil t))

(defcustom eproject-completing-read-function
  #'eproject--icompleting-read
  "Ask the user select a single file from a list of files.
Used by `eproject-find-file'."
  :group 'eproject
  :type '(radio (function-item :doc "Use emacs' standard completing-read function."
                               eproject--completing-read)
                (function-item :doc "Use iswitchb's completing-read function."
                               eproject--icompleting-read)
                (function-item :doc "Use ido's completing-read function."
                               eproject--ido-completing-read)
                (function)))

(defun eproject--do-completing-read (&rest args)
  "Do a completing read with the user's favorite completing read function."
  (apply eproject-completing-read-function args))

(defun eproject--icomplete-read-with-alist (prompt alist)
  (let ((show (mapcar (lambda (x) (car x)) alist)))
    (cdr (assoc (eproject--do-completing-read prompt show) alist))))

(defun eproject--project-buffers ()
  "Return an alist mapping each project root to its open buffers.

Does not list the project if it doesn't have any buffers."
  (let ((hash (make-hash-table :test 'equal)))
    (loop for x in
          (mapcar (lambda (b) (ignore-errors (cons (eproject-root b) b)))
                  (buffer-list))
          when (not (null x))
          do (puthash (car x)
                      (cons (cdr x) (gethash (car x) hash)) hash))
    (loop for key being the hash-keys of hash
          collect (cons key (gethash key hash)))))

(defun* eproject--get-name-root-alist (&key live-only)
  (let ((all-projects (eproject-projects))
        (buffers      (eproject--project-buffers)))

    (when (null all-projects)
      (error "No projects yet"))

    (if live-only
        (remove-if #'null (mapcar (lambda (x) (rassoc (car x) all-projects)) buffers))
      all-projects)))

(defun* eproject--read-project-name (&key live-only)
  (eproject--icomplete-read-with-alist
   "Project name: " (eproject--get-name-root-alist :live-only live-only)))

(defun* eproject--handle-root-prefix-arg (prefix &key live-only)
  (if (= prefix 4)
      (eproject--read-project-name :live-only live-only)
    (eproject-root)))

;; ibuffer support

(define-ibuffer-filter eproject-root
    "Filter buffers that have the provided eproject root"
  (:reader (read-directory-name "Project root: " (ignore-errors (eproject-root)))
   :description "project root")
  (with-current-buffer buf
    (equal (file-name-as-directory (expand-file-name qualifier))
           (ignore-errors (eproject-root)))))

(define-ibuffer-filter eproject
    "Filter buffers that have the provided eproject name"
  (:reader (eproject--do-completing-read "Project name: " (eproject-project-names))
   :description "project name")
  (with-current-buffer buf
    (equal qualifier
           (ignore-errors (eproject-name)))))

(define-ibuffer-column eproject (:name "Project" :inline t)
  (ignore-errors (eproject-name)))

;;;###autoload
(defun eproject-ibuffer (prefix)
  "Open an IBuffer window showing all buffers in the current project, or named project if PREFIX arg is supplied."
  (interactive "p")
  (if (= prefix 4)
      (call-interactively #'eproject--ibuffer-byname)
    (ibuffer nil "*Project Buffers*"
             (list (cons 'eproject-root (eproject-root))))))

(defun eproject--ibuffer-byname (project-name)
  "Open an IBuffer window showing all buffers in the project named PROJECT-NAME."
  (interactive (list
                (eproject--do-completing-read
                 "Project name: " (eproject-project-names))))
  (ibuffer nil (format "*%s Buffers*" project-name)
           (list (cons 'eproject project-name))))

;; extra macros

(defmacro* with-each-buffer-in-project
    ((binding &optional project-root)
     &body body)
  "Given a project root PROJECT-ROOT, finds each buffer visiting a file in that project, and executes BODY with each buffer bound to BINDING (and made current)."
  (declare (indent 2))
  `(progn
     (loop for ,binding in (cdr (assoc (or ,project-root (eproject-root))
                                           (eproject--project-buffers)))
           do
           (with-current-buffer ,binding
             ,@body))))

;; bulk management utils
;;;###autoload
(defun eproject-kill-project-buffers (prefix)
  "Kill every buffer in the current project, including the current buffer.

If PREFIX is specified, prompt for a project name and kill those
buffers instead."
  (interactive "p")
  (with-each-buffer-in-project
      (buf (eproject--handle-root-prefix-arg prefix :live-only t))
    (kill-buffer buf)))

(defun eproject-open-all-project-files (prefix)
  "Open every file in the same project.

If PREFIX arg is supplied, prompt for a project.  Otherwise,
assume the project of the current buffer."
  (interactive "p")
  (let ((total 0)
        (root (eproject--handle-root-prefix-arg prefix)))
    (message "Opening files...")
    (save-window-excursion
      (loop for file in (eproject-list-project-files root)
            do (progn (find-file file) (incf total))))
    (message "Opened %d files" total)))

;; project management

(defun eproject-project-root (project)
  "Given a PROJECT name, return the root directory."
  (let ((projects (eproject--get-name-root-alist)))
    (cdr (assoc project projects))))

;;;###autoload
(defun eproject-revisit-project (prefix)
  "Given a project name, visit the root directory.

If PREFIX arg is supplied, run `eproject-find-file'."
  (interactive "p")
  (let ((eproject-root (eproject--read-project-name))
        (eproject-mode t)) ;; XXX: very messy, needs rewrite
    (if (= prefix 4)
          (eproject-find-file)
      (find-file eproject-root))))

;; grep project files (contributed by Julian Snitow)

;; TODO: make the grep command customizable; to use "Ack", for example
;;;###autoload
(defun eproject-grep (regexp)
  "Search all files in the current project for REGEXP."
  (interactive "sRegexp grep: ")
  (let* ((root (eproject-root))
         (default-directory root)
         (files (eproject-list-project-files-relative root)))
    (grep-compute-defaults)
    (lgrep regexp (combine-and-quote-strings files) root)))

(defcustom eproject-todo-expressions
  '("TODO" "XXX" "FIXME")
  "A list of tags for `eproject-todo' to search for when generating the project's TODO list."
  :group 'eproject
  :type '(repeat string))

;;;###autoload
(defun eproject-todo ()
  "Display a project TODO list.

Customize `eproject-todo-expressions' to control what this function looks for."
  (interactive)
  ;; TODO: display output in a buffer called *-TODO* instead of *grep*.
  (eproject-grep (regexp-opt eproject-todo-expressions)))

;;;###autoload
(defun eproject-multi-isearch-buffers ()
  "Do a `multi-isearch' on opened buffers in the current project.

Run `eproject-open-all-project-files' first or just
`eproject-grep' if you want to search all project files."
  (interactive)
  (multi-isearch-buffers
   (cdr (assoc (eproject-root) (eproject--project-buffers)))))

;;;###autoload
(defun eproject-eshell-cd-here (&optional look-in-invisible-buffers)
  "If there is an EShell buffer, cd to the project root in that buffer.

With the prefix arg LOOK-IN-INVISIBLE-BUFFERS looks in buffers that are not currently displayed."
  (interactive "p")
  (setq look-in-invisible-buffers (cond ((= look-in-invisible-buffers 4) t)))
  (let* ((root (eproject-root))
         (eshell-p (lambda (buf)
                     (with-current-buffer buf (eq major-mode 'eshell-mode))))
         (eshell-buffer (find-if eshell-p
                                 (if look-in-invisible-buffers
                                     (buffer-list)
                                   (mapcar (lambda (w) (window-buffer w))
                                           (window-list))))))

    (cond ((and (not eshell-buffer) look-in-invisible-buffers)
           (error "No EShell buffer!"))
          ((and (not eshell-buffer) (not look-in-invisible-buffers))
           (error "No visible EShell buffer; try re-running with the prefix arg"))
          (eshell-buffer
           (with-current-buffer eshell-buffer
             (goto-char (point-max))
             (eshell/cd root)
             (eshell-send-input nil t)
             eshell-buffer))))) ;; returns eshell-buf so you can focus
                                ;; the window if you want

;;;###autoload
(defun eproject-compile ()
  "Run `compile-command' in the project root."
  (interactive)
  (let ((default-directory (eproject-root)))
    (call-interactively #'compile)))

(define-key eproject-mode-map (kbd "C-c C-f") #'eproject-find-file)
(define-key eproject-mode-map (kbd "C-c C-b") #'eproject-ibuffer)

(provide 'eproject-extras)
;;; eproject-extras.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/setnu.el0000775000000000000000000004041212230377266020730 0ustar  ;;; vi-style line number mode for Emacs
;;; (requires Emacs 19.29 or later, or XEmacs 19.14 or later)
;;; Copyright (C) 1994, 1995, 1997 Kyle E. Jones
;;;
;;; 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 2, 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.
;;;
;;; A copy of the GNU General Public License can be obtained from this
;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.
;;;
;;; Send bug reports to kyle@wonderworks.com
;;
;; M-x setnu-mode toggles the line number mode on and off.
;;
;; turn-on-setnu-mode is useful for adding to a major-mode hook
;; variable.
;; Example:
;;     (add-hook 'text-mode-hook 'turn-on-setnu-mode)
;; to automatically turn on line numbering when enterting text-mode."

(provide 'setnu)

(defconst setnu-running-under-xemacs
  (or (string-match "XEmacs" emacs-version)
      (string-match "Lucid" emacs-version)))

(defconst setnu-mode-version "1.06"
  "Version number for this release of setnu-mode.")

(defvar setnu-mode nil
  "Non-nil if setnu-mode is active in the current buffer.")
(make-variable-buffer-local 'setnu-mode)

(defvar setnu-start-extent nil
  "First extent of a chain of extents used by setnu-mode.
Each line has its own extent.  Each line extent has a
`setnu-next-extent' property that points to the next extent in
the chain, which is the extent for the next line in the buffer.
There is also a `setnu-prev-extent' that points at the previous
extent in the chain.  To distinguish them from other extents the
setnu-mode extents all have a non-nil `setnu' property.")
(make-variable-buffer-local 'setnu-start-extent)

(defvar setnu-glyph-obarray (make-vector 401 0)
  "Obarray of symbols whose values are line number glyphs.
Each symbol name is the string represnetation of a number, perhaps
passed with spaces.  The value of the symbol is a glyph that can
be made the begin glyph of an extent to display as a line number.")

(defvar setnu-begin-glyph-property (if (fboundp 'extent-property)
				       'begin-glyph
				     'before-string)
  "Property name to use to set the begin glyph of an extent.")

(defvar setnu-line-number-format (if setnu-running-under-xemacs "%4d" "%6d  ")
  "String suitable for `format' that will generate a line number string.
`format' will be called with this string and one other argument
which will be an integer, the line number.")

(defvar setnu-line-number-face 'bold
  "*Face used to display the line numbers.
Currently this works for XEmacs 19.12 and later versions only.")

(defun setnu-mode (&optional arg)
  "Toggle setnu-mode.
With prefix argument, turn setnu-mode on if argument is positive.
When setnu-mode is enabled, a line number will appear at the left
margin of each line."
  (interactive "P")
  (let ((oldmode (not (not setnu-mode)))
	(inhibit-quit t))
    (setq setnu-mode (or (and arg (> (prefix-numeric-value arg) 0))
			 (and (null arg) (null setnu-mode))))
    (if (not (eq oldmode setnu-mode))
	(if setnu-mode
	    (setnu-mode-on)
	  (setnu-mode-off)))))

(defun turn-on-setnu-mode ()
  "Turn on setnu-mode.
Useful for adding to a major-mode hook variable.
Example:
    (add-hook 'text-mode-hook 'turn-on-setnu-mode)
to automatically turn on line numbering when enterting text-mode."
  (setnu-mode 1))

;;; Internal functions

;;; The program is written using XEmacs terminology,
;;; e.g. extents, glyphs, etc.  Functions are defined to twist
;;; the FSF Emacs overlay API into the XEmacs model.

(defconst setnu-running-under-xemacs
  (or (string-match "XEmacs" emacs-version)
      (string-match "Lucid" emacs-version)))

(if setnu-running-under-xemacs
    (fset 'setnu-make-extent 'make-extent)
  (fset 'setnu-make-extent 'make-overlay))

(if setnu-running-under-xemacs
    (fset 'setnu-delete-extent 'delete-extent)
  (fset 'setnu-delete-extent 'delete-overlay))

(if setnu-running-under-xemacs
    (fset 'setnu-extent-property 'extent-property)
  (fset 'setnu-extent-property 'overlay-get))

(if setnu-running-under-xemacs
    (fset 'setnu-set-extent-property 'set-extent-property)
  (fset 'setnu-set-extent-property 'overlay-put))

(if setnu-running-under-xemacs
    (fset 'setnu-set-extent-endpoints 'set-extent-endpoints)
  (fset 'setnu-set-extent-endpoints 'move-overlay))

(if setnu-running-under-xemacs
    (fset 'setnu-extent-end-position 'extent-end-position)
  (fset 'setnu-extent-end-position 'overlay-end))

(if setnu-running-under-xemacs
    (fset 'setnu-extent-start-position 'extent-start-position)
  (fset 'setnu-extent-start-position 'overlay-start))

(if setnu-running-under-xemacs
    (defun setnu-set-extent-begin-glyph (e g)
      (set-extent-begin-glyph e g 'outside-margin))
  (defun setnu-set-extent-begin-glyph (e g)
    (overlay-put e setnu-begin-glyph-property g)))
    
(fset 'setnu-make-glyph (if setnu-running-under-xemacs 'make-glyph 'identity))

(cond ((and setnu-running-under-xemacs (fboundp 'set-glyph-face))
       (fset 'setnu-set-glyph-face 'set-glyph-face))
      (setnu-running-under-xemacs
       (fset 'setnu-set-glyph-face 'ignore))
      (t				; FSF Emacs
       (defun setnu-set-glyph-face (g face)
	 (put-text-property 0 (length g) 'face face g))))

(defun setnu-mode-off ()
  "Internal shutdown of setnu-mode.
Deletes the extents associated with setnu-mode."
  (if (and setnu-running-under-xemacs
	   (fboundp 'remove-specifier))
      (remove-specifier left-margin-width (current-buffer)))
  (if setnu-start-extent
      (let (e ee)
	(setq e setnu-start-extent)
	(while e
	  (setq ee e)
	  (setq e (setnu-extent-property e 'setnu-next-extent))
	  (setnu-delete-extent ee))
	(setq setnu-start-extent nil))))

(defun setnu-mode-on ()
  "Internal startup of setnu-mode.
Sets up the extents associated with setnu-mode."
  (if (and setnu-running-under-xemacs
	   (fboundp 'set-specifier))
      (set-specifier left-margin-width 6 (current-buffer)))
  (let ((done nil)
	(curr-e nil)
	(n 1)
	(match-data (match-data))
	e start numstr)
    (unwind-protect
	(save-excursion
	  (save-restriction
	    (widen)
	    (goto-char (point-min))
	    (setq start (point))
	    (while (not done)
	      (setq done (null (search-forward "\n" nil 0)))
	      (setq e (setnu-make-setnu-extent start (point)))
	      (if (null setnu-start-extent)
		  (setq setnu-start-extent e
			curr-e e)
		(setnu-set-extent-property curr-e 'setnu-next-extent e)
		(setnu-set-extent-property e 'setnu-prev-extent curr-e)
		(setq curr-e e))
	      (setq numstr (format setnu-line-number-format n))
	      (setnu-set-extent-property e 'line-number numstr)
	      (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr))
	      (setq n (1+ n)
		    start (point)))))
      (store-match-data match-data))))

(defun setnu-before-change-function (start end)
  "Before change function for setnu-mode.
Notices when a delete is about to delete some lines and adjusts
the line number extents accordingly."
  (if (or (not setnu-mode) (= start end))
      () ;; not in setnu-mode or this is an insertion
    (let ((inhibit-quit t)
	  (start-e nil)
	  (match-data (match-data))
	  end-e saved-next e ee)
      (unwind-protect
	  (save-excursion
	    (save-restriction
	      (widen)
	      (goto-char start)
	      (if (search-forward "\n" end t)
		  (progn
		    (setq start-e (setnu-extent-at-create start nil)
			  saved-next (setnu-extent-property
				      start-e
				      'setnu-next-extent))
		    (setq end-e (setnu-extent-at-create end nil))
		    (setnu-set-extent-endpoints
		     start-e
		     (setnu-extent-start-position start-e)
		     (setnu-extent-end-position end-e))
		    (setnu-set-extent-property
		     start-e 'setnu-next-extent
		     (setnu-extent-property end-e 'setnu-next-extent))))
	      (if start-e
		  (progn
		    (setq e (setnu-extent-property start-e 'setnu-next-extent)
			  ee saved-next)
		    (while (and e (setnu-extent-property e 'setnu-next-extent))
		      (setq e (setnu-extent-property e 'setnu-next-extent)
			    ee (setnu-extent-property ee 'setnu-next-extent)))
		    (while (and e (not (eq ee start-e)))
		      (setnu-set-extent-begin-glyph
		       e (setnu-extent-property ee setnu-begin-glyph-property))
		      (setnu-set-extent-property
		       e 'line-number (setnu-extent-property ee 'line-number))
		      (setq e (setnu-extent-property e 'setnu-prev-extent)
			    ee (setnu-extent-property ee 'setnu-prev-extent)))
		    (setq end-e (setnu-extent-property start-e
						       'setnu-next-extent))
		    (and end-e
			 (setnu-set-extent-property end-e
						    'setnu-prev-extent
						    start-e))
		    (setq e saved-next)
		    (while (not (eq e end-e))
		      (setq ee e
			    e (setnu-extent-property e 'setnu-next-extent))
		      (setnu-delete-extent ee))))))
	(store-match-data match-data)))))

(defun setnu-after-change-function (start end length)
  "After change function for setnu-mode.
Notices when an insert has added some lines and adjusts
the line number extents accordingly."
  (if (or (not setnu-mode) (= start end))
      () ; not in setnu-mode or this is a deletion
    (let ((inhibit-quit t)
	  (ee nil)
	  (match-data (match-data))
	  (new-lines 0)
	  start-e e saved-end saved-next n numstr)
      (unwind-protect
	  (save-excursion
	    (save-restriction
	      (widen)
	      (setq start-e (setnu-extent-at-create start nil))
	      (if (< (setnu-extent-end-position start-e) (point))
		  ;; bogus!  insertion didn't put the text into
		  ;; the extent because,
		  ;; a. the extent was zero length or
		  ;; b. this is FSF Emacs which means chars
		  ;;    inserted at the end position of an extent
		  ;;    are not inserted into the extent.
		  (setnu-set-extent-endpoints
		   start-e
		   (setnu-extent-start-position start-e)
		   end))
	      (setq saved-next (setnu-extent-property start-e
						      'setnu-next-extent)
		    saved-end (setnu-extent-end-position start-e)
		    e start-e)
	      (goto-char start)
	      (while (search-forward "\n" end 0)
		(setnu-set-extent-endpoints e
					    (setnu-extent-start-position e)
					    (point))
		(setq ee (setnu-make-setnu-extent (point) (point)))
		(setnu-set-extent-property e 'setnu-next-extent ee)
		(setnu-set-extent-property ee 'setnu-prev-extent e)
		(setq e ee new-lines (1+ new-lines)))
	      (if ee
		  (progn
		    (setnu-set-extent-endpoints
		     e (setnu-extent-start-position e) saved-end)
		    (setnu-set-extent-property e 'setnu-next-extent saved-next)
		    (and saved-next
			 (setnu-set-extent-property
			  saved-next 'setnu-prev-extent e))
		    (setq e (setnu-extent-property start-e 'setnu-next-extent)
			  ee saved-next)
		    (while ee
		      (setnu-set-extent-begin-glyph
		       e (setnu-extent-property ee setnu-begin-glyph-property))
		      (setnu-set-extent-property
		       e 'line-number (setnu-extent-property ee 'line-number))
		      (setq e (setnu-extent-property e 'setnu-next-extent)
			    ee (setnu-extent-property ee 'setnu-next-extent)))
		    (setq n (1+ (string-to-int
				 (setnu-extent-property
				  (setnu-extent-property e 'setnu-prev-extent)
				  'line-number))))
		    (while e
		      (setq numstr (format setnu-line-number-format n))
		      (setnu-set-extent-property e 'line-number numstr)
		      (setnu-set-extent-begin-glyph
		       e (setnu-number-glyph numstr))
		      (setq e (setnu-extent-property e 'setnu-next-extent)
			    n (1+ n)))))))
	(store-match-data match-data)))))

(defun setnu-number-glyph (number-string)
  (let ((sym (intern number-string setnu-glyph-obarray)))
    (if (boundp sym)
	(symbol-value sym)
      (let ((g (setnu-make-glyph number-string)))
	(set sym g)
	(setnu-set-glyph-face g setnu-line-number-face)
	g ))))

(defun setnu-make-setnu-extent (beg end)
  "Create an extent and set some properties that all setnu extents have."
  (let ((e (setnu-make-extent beg end)))
    (setnu-set-extent-property e 'setnu t)
;;    (setnu-set-extent-property e 'begin-glyph-layout 'outside-margin)
    (setnu-set-extent-property e 'detachable nil)
    (setnu-set-extent-property e 'evaporate nil)
    e ))

(cond ((fboundp 'overlays-in) ;; expect to see this in 19.30
       (defun setnu-extent-at (pos buf)
	 "Finds the setnu extent at the position POS in the buffer BUF."
	 (catch 'done
	   (save-excursion
	     (and buf (set-buffer buf))
	     (let ((o-list (overlays-in pos (1+ pos))))
	       (while o-list
		 (if (overlay-get (car o-list) 'setnu)
		     (throw 'done (car o-list)))
		 (setq o-list (cdr o-list)))
	       nil )))))
      ((fboundp 'overlays-at)
       (defun setnu-extent-at (pos buf)
	 "Finds the setnu extent at the position POS in the buffer BUF."
	 (catch 'done
	   (save-excursion
	     (and buf (set-buffer buf))
	     (let ((o-list (overlays-at pos)) o-lists)
	       ;; search what overlays-at returns first.  for all
	       ;; but zero length extents this will return the
	       ;; extent we want.
	       (while o-list
		 (if (overlay-get (car o-list) 'setnu)
		     (throw 'done (car o-list)))
		 (setq o-list (cdr o-list)))
	       ;; No luck.  Search the lists returned by
	       ;; overlay-lists.  Use overlays-recenter so we only
	       ;; have to search the `before' lobe of the return
	       ;; value.
	       (overlay-recenter (1- pos))
	       (setq o-lists (overlay-lists))
	       (setq o-list (cdr o-lists))
	       (while o-list
		 (if (and (overlay-get (car o-list) 'setnu)
			  (or (and (= pos (overlay-start (car o-list)))
				   (= pos (overlay-end (car o-list))))
			      (and (>= pos (overlay-start (car o-list)))
				   (< pos (overlay-end (car o-list))))))
		     (throw 'done (car o-list)))
		 (setq o-list (cdr o-list)))
	       nil )))))
       ((fboundp 'map-extents)
	(defun setnu-extent-at (pos buf)
	  "Finds the setnu extent at the position POS in the buffer BUF."
	  (map-extents (function (lambda (e maparg)
				   (if (setnu-extent-property e 'setnu)
				       e
				     nil)))
		       buf pos pos)))
       (t (error "can't find overlays-in, overlays-at, or map-extents!")))

(defun setnu-extent-at-create (pos buf)
  "Like `setnu-extent-at' except if an extent isn't found, then
it is created based on where the extent failed to be found."
  (let ((e (setnu-extent-at pos buf)) ee beg numstr)
    (if e
	e
      ;; no extent found so one must be created.
      (save-excursion
	(goto-char pos)
	(beginning-of-line)
	(setq e (setnu-extent-at (point) buf))
	(cond (e
	       ;; found one.  extend it to cover this whole line.
	       ;; this takes care of zero length extents that
	       ;; might exist at bob or eob that can't be
	       ;; inserted into.
	       (setq beg (point))
	       (forward-line 1)
	       (setnu-set-extent-endpoints e beg (point))
	       e )
	      ((bobp)
	       ;; we are at bob and there's no extent.
	       ;;
	       ;; this is because the extent that was there got
	       ;; detached because all the text in the buffer was
	       ;; deleted.  so we create a new extent and make it
	       ;; contain the whole buffer, since there can be no
	       ;; other attached extents.
	       (setq e (setnu-make-setnu-extent (point-min) (point-max))
		     numstr (format setnu-line-number-format 1))
	       (setnu-set-extent-property e 'line-number numstr)
	       (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr))
	       (setq setnu-start-extent e)
	       e )
	      (t
	       ;; we must be at eob and there's no extent.
	       ;; 
	       ;; this is because the extent that was there
	       ;; shrank to zero length and was detached.  create
	       ;; a new extent that contains all text from point
	       ;; to pos.
	       (setq e (setnu-make-setnu-extent (point) pos))
	       (setq ee (setnu-extent-at (1- (point)) buf))
	       (setnu-set-extent-property e 'setnu-prev-extent ee)
	       (setnu-set-extent-property ee 'setnu-next-extent e)
	       (setq numstr
		     (format setnu-line-number-format
			     (1+ (string-to-int
				  (setnu-extent-property ee 'line-number)))))
	       (setnu-set-extent-property e 'line-number numstr)
	       (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr))
	       e ))))))

(add-hook 'before-change-functions 'setnu-before-change-function)
(add-hook 'after-change-functions 'setnu-after-change-function)
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/muttrc-mode.el0000775000000000000000000015275512230377265022047 0ustar  ;;; muttrc-mode.el --- Major mode to edit muttrc under Emacs

;;; Copyright (C) 2000, 2001, 2002 Laurent Pelecq
;;; Copyright (C) 2009 Kumar Appaiah
;;;
;;; Authors: Laurent Pelecq 
;;;          Kumar Appaiah 

;;; 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 2, 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, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Supported Emacs:
;;; ================
;;; This mode has only been tested on Emacs 21.2. If you
;;; encounter problems with older versions or with Xemacs, let me
;;; know.

;;; Installation:
;;; =============
;;; Add this lines to your .emacs:
;;;   (autoload 'muttrc-mode "muttrc-mode.el"
;;;   	"Major mode to edit muttrc files" t)
;;;   (setq auto-mode-alist
;;;   	    (append '(("muttrc\\'" . muttrc-mode))
;;;   		    auto-mode-alist))
;;; Be sure this file is in a directory that appears in the load-path.
;;;
;;; You mail want to use this mode for other files like the mail
;;; aliases file. In that case just add the following lines at the end
;;; of these files:
;;;   ### Local Variables: ***
;;;   ### mode: muttrc ***
;;;   ### End: ***

;;; Customization:
;;; ==============
;;; Execute: M-x configure-group RET muttrc RET
;;;
;;; By default, help on command/variable is displayed automatically
;;; while executing a command to modify them. Disable this feature if
;;; you have problems with.

;;; Description:
;;; ============
;;; This mode first goal is to provide syntax highlighting with
;;; font-lock. The basic fontification appears on strings, comments,
;;; command names and variables. Additional fontification for commands
;;; arguments can be enabled through the customization buffer.
;;;
;;; Main commands are:
;;; C-x c -- muttrc-insert-command
;;; C-x s -- muttrc-set-variable
;;; C-x S -- muttrc-unset-variable
;;;
;;; Type C-h m for all key bindings.

;;; BUGS:
;;; =====
;;; - Multiline commands are not properly handled and can lead to
;;;   unexpected result.



;;; Code:

;;; ------------------------------------------------------------
;;; Requirement
;;; ------------------------------------------------------------

(require 'man)

(defconst muttrc-mode-version "$Revision: 1.2 $")

;;; ------------------------------------------------------------
;;; Configurable stuff
;;; ------------------------------------------------------------

(defgroup muttrc nil
  "Muttrc editing commands for Emacs."
  :group 'files
  :prefix "muttrc-")

(defcustom muttrc-manual-path "/usr/share/doc/mutt/manual.txt.gz"
  "Path to the Mutt manual."
  :type 'string
  :group 'muttrc)

(defcustom muttrc-display-help t
  "Display help for each command/variable modification if set."
  :type 'boolean
  :group 'muttrc)

(defcustom muttrc-folder-abbrev ?+
  "Character used to refer to the folder directory."
  :type '(choice (const :tag "+" ?+)
		 (const :tag "=" ?=))
  :group 'muttrc)

(defcustom muttrc-argument-faces-alist
  '((alias . bold)
    (address . default)
    (face . default)
    (color . default)
    (command . default)
    (path . default)
    (function . default)
    (header . default)
    (hook . default)
    (key . default)
    (map . default)
    (mimetype . default)
    (object . default)
    (regexp . default)
    (sequence . default)
    (string . default)
    (hook-type . default))
  "List of faces for the Muttrc command arguments. Standard faces are
symbols like 'bold, 'underline, ... Muttrc files must be revisited in
order for the modifications to take effect."
  :type '(repeat (cons symbol symbol))
  :group 'muttrc)

;;; ------------------------------------------------------------
;;; For backward compatibility
;;; ------------------------------------------------------------

(or (functionp 'match-string-no-properties)
    (defalias 'match-string-no-properties 'match-string))

;;; ------------------------------------------------------------
;;; Mutt variables and commands
;;; ------------------------------------------------------------

(defconst muttrc-arg-handler-alist
  '((alias muttrc-get-word "Alias")
    (boolean muttrc-get-boolean "Enable")
    (number muttrc-get-number "Number")
    (address muttrc-get-string "Address")
    (face muttrc-get-from-list "Face" muttrc-face-alist t)
    (color muttrc-get-from-list "Color" muttrc-color-alist)
    (command muttrc-get-command "Command")
    (statement muttrc-get-statement "Command")
    (assignment muttrc-get-assignment "Variable" t)
    (variable muttrc-get-assignment "Variable" nil)
    (path muttrc-get-path "Path")
    (function muttrc-get-from-list "Function" muttrc-mutt-function-alist)
    (header muttrc-get-from-list "Header name" muttrc-header-alist)
    (hook-type muttrc-get-from-list "Hook" muttrc-hook-alist t)
    (key muttrc-get-string "Key")
    (map muttrc-get-from-list "Map" muttrc-map-alist t)
    (mimetype muttrc-get-from-list "MIME type" muttrc-mimetype-alist)
    (object muttrc-get-from-list "Object" muttrc-object-alist)
    (regexp muttrc-get-string "Regular expression")
    (sequence muttrc-get-string "Sequence")
    (string muttrc-get-string "String")
    (alias-sort-order muttrc-get-from-list "Sort order"
		      muttrc-alias-sort-order-alist)
    (aux-sort-order  muttrc-get-from-list "Sort order"
		    muttrc-aux-sort-order-alist)
    (browser-sort-order muttrc-get-from-list "Sort order"
			muttrc-browser-sort-order-alist)
    (pgp-sort-order muttrc-get-from-list "Sort order"
		    muttrc-pgp-sort-order-alist)
    (quadoption muttrc-get-from-list "Option" muttrc-quadoption-alist)
    (sort-order muttrc-get-from-list "Sort order"
		muttrc-sort-order-alist))
  "List of handler for each type of argument. The format is:
\(ARG-TYPE FACE HANDLER PROMPT HANDLER-ARGS\).
The PROMPT can be overwritten by in command description.")

(defconst muttrc-face-alist
  '(("none" . 1) ("bold" . 2) ("underline" . 3)
    ("reverse" . 4) ("standout". 5)))

(defconst muttrc-color-alist
  '(("default" . 0)
    ("black" . 1) ("blue" . 2) ("cyan" . 3) ("green" . 4)
    ("magenta" . 5) ("red" . 6) ("white" . 7) ("yellow" . 8)
    ("brightdefault" . 9)
    ("brightblack" . 10) ("brightblue" . 11) ("brightcyan" . 12)
    ("brightgreen" . 13) ("brightmagenta" . 14) ("brightred" . 15)
    ("brightwhite" . 16) ("brightyellow" . 17)))

(defconst muttrc-object-alist
  '(("attachment" . 0)
    ("body" . 1)
    ("bold" . 2)
    ("error" . 3)
    ("hdrdefault" . 4)
    ("header" . 5)
    ("index" . 6)
    ("indicator" . 7)
    ("markers" . 8)
    ("message" . 9)
    ("normal" . 10)
    ("quoted" . 11)
    ("search" . 12)
    ("signature" . 13)
    ("status" . 14)
    ("tilde" . 15)
    ("tree" . 16)
    ("underline" . 17))
  "Mutt object on which color apply.")

(defconst muttrc-header-alist
  '(("content-transfer-encoding" . 0)
    ("content-type" . 1)
    ("date" . 2)
    ("from" . 3)
    ("message-id" . 4)
    ("mime-version" . 5)
    ("organization" . 6)
    ("received" . 7)
    ("reply-to" . 8)
    ("resent-from" . 9)
    ("subject" . 10)
    ("to" . 11)
    ("x-accept-language" . 12)
    ("x-mailer" . 13)
    ("x-mimetrack" . 14)
    ("x-sender" . 15)))

(defconst muttrc-hook-alist
  '(("folder-hook" . 0) ("send-hook" . 1) ("save-hook" . 2)
    ("mbox-hook" . 3) ("fcc-hook" . 4) ("fcc-save-hook" . 5)
    ("message-hook" . 5) ("charset-hook" . 6) ("iconv-hook" . 7)
    ("account-hook" . 8) ("append-hook" . 9) ("close-hook" . 10)
    ("crypt-hook" . 11) ("send2-hook" . 12) ("reply-hook" . 13)
    ("open-hook" . 14)))

(defconst muttrc-map-alist
  '(("alias" . 0) ("attach" . 1) ("browser" . 2) ("compose" . 3)
    ("editor" . 4) ("generic" . 5) ("index" . 6) ("pager" . 7)
    ("pgp" . 8) ("postpone" . 9) ("query" . 10)))

(defconst muttrc-mimetype-alist
  '(("application/andrew-inset" "ez")
    ("application/excel" "xls")
    ("application/fractals" "fif")
    ("application/java-archive" "jar")
    ("application/mac-binhex40" "hqx")
    ("application/msword" "doc" "dot")
    ("application/octet-stream" "exe" "bin")
    ("application/oda" "oda")
    ("application/pdf" "pdf")
    ("application/pdf")
    ("application/pgp" "pgp")
    ("application/postscript" "ai" "eps" "ps" "PS")
    ("application/pre-encrypted" "enc")
    ("application/rtf" "rtf")
    ("application/vnd.lotus-wordpro" "lwp" "sam")
    ("application/vnd.ms-access" "mdb" "mda" "mde")
    ("application/vnd.ms-excel" "xls")
    ("application/vnd.ms-powerpoint" "ppt" "pot" "ppa" "pps" "pwz")
    ("application/vnd.ms-schedule" "scd" "sch" "sc2")
    ("application/wordperfect5.1" "wpd" "wp6")
    ("application/x-arj-compressed" "arj")
    ("application/x-bcpio" "bcpio")
    ("application/x-chess-pgn" "pgn")
    ("application/x-cpio" "cpio")
    ("application/x-csh" "csh")
    ("application/x-debian-package" "deb")
    ("application/x-dvi" "dvi")
    ("application/x-fortezza-ckl" "ckl")
    ("application/x-gtar" "gtar")
    ("application/x-gunzip" "gz")
    ("application/x-hdf" "hdf")
    ("application/x-javascript" "js" "mocha")
    ("application/x-javascript-config" "jsc")
    ("application/x-latex" "latex")
    ("application/x-mif" "mif")
    ("application/x-msdos-program" "com" "exe" "bat")
    ("application/x-netcdf" "cdf" "nc")
    ("application/x-ns-proxy-autoconfig" "pac")
    ("application/x-ns-proxy-autoconfig")
    ("application/x-perl" "pl" "pm")
    ("application/x-pkcs7-crl" "crl")
    ("application/x-pkcs7-mime" "p7m" "p7c")
    ("application/x-pkcs7-signature" "p7s")
    ("application/x-rar-compressed" "rar")
    ("application/x-sh" "sh")
    ("application/x-shar" "shar")
    ("application/x-stuffit" "sit")
    ("application/x-sv4cpio" "sv4cpio")
    ("application/x-sv4crc" "sv4crc")
    ("application/x-tar" "tar")
    ("application/x-tar-gz" "tgz" "tar.gz")
    ("application/x-tcl" "tcl")
    ("application/x-tex" "tex")
    ("application/x-texinfo" "texi" "texinfo")
    ("application/x-troff" "t" "tr" "roff")
    ("application/x-troff-man" "man")
    ("application/x-troff-me" "me")
    ("application/x-troff-ms" "ms")
    ("application/x-ustar" "ustar")
    ("application/x-wais-source" "src")
    ("application/x-zip-compressed" "zip")
    ("audio/basic" "au" "snd")
    ("audio/basic" "snd")
    ("audio/midi" "mid" "midi")
    ("audio/ulaw" "au")
    ("audio/x-aiff" "aif" "aifc" "aiff")
    ("audio/x-aiff" "aif" "aiff" "aifc")
    ("audio/x-wav" "wav")
    ("image/gif" "gif")
    ("image/ief" "ief")
    ("image/jpeg" "jpe" "jpeg" "jpg")
    ("image/png" "png")
    ("image/tiff" "tif" "tiff")
    ("image/tiff")
    ("image/x-MS-bmp" "bmp")
    ("image/x-cmu-raster" "ras")
    ("image/x-photo-cd" "pcd")
    ("image/x-portable-anymap" "pnm")
    ("image/x-portable-bitmap" "pbm")
    ("image/x-portable-graymap" "pgm")
    ("image/x-portable-pixmap" "ppm")
    ("image/x-rgb" "rgb")
    ("image/x-xbitmap" "xbm")
    ("image/x-xpixmap" "xpm")
    ("image/x-xwindowdump" "xwd")
    ("text/html" "html" "htm" "shtml")
    ("text/plain" "txt" "text")
    ("text/richtext" "rtx")
    ("text/tab-separated-values" "tsv")
    ("text/x-setext" "etx")
    ("text/x-vcard" "vcf")
    ("text/x-vcard")
    ("video/dl" "dl")
    ("video/fli" "fli")
    ("video/gl" "gl")
    ("video/mpeg" "mpeg" "mpg" "mpe" "mpv" "vbs" "mpegv")
    ("video/quicktime" "qt" "mov" "moov")
    ("video/x-msvideo" "avi")
    ("video/x-sgi-movie" "movie")
    ("x-world/x-vrml" "vrm" "vrml" "wrl")))

(defconst muttrc-command-alist
  '(
    ("folder-hook"		((string) (statement)) nil nil)
    ("alias"			((alias) (address)) t nil)
    ("unalias"			((alias) (address)) t nil)
    ("alternative_order"	((mimetype)) t nil)
    ("auto_view"		((mimetype)) t nil)
    ("bind"			((map) (key) (function)) nil t)
    ("color"			((object)
				 (color "Foreground")
				 (color "Background")
				 (regexp)) nil t)
    ("charset-hook"		((string "Alias")
				 (string "Charset")) nil nil)
    ("fcc-hook"			((regexp) (path)) nil nil)
    ("fcc-save-hook"		((regexp) (path)) nil nil)
    ("folder-hook"		((regexp) (statement)) nil nil)
    ("ignore"			((header)) t nil)
    ("iconv-hook"		((string "Charset")
				 (string "Local charset")) nil nil)
    ("unignore"			((header)) t nil)
    ("hdr_order"		((header)) t nil)
    ("unhdr_order"		((header)) t nil)
    ("lists"			((address)) t nil)
    ("unlists"			((address)) t nil)
    ("macro"			((map) (key) (sequence)
				 (string "Description")) nil t)
    ("mailboxes"		((path)) t nil)
    ("mono"			((object) (face) (regexp)) nil t)
    ("mbox-hook"		((regexp) (path)) nil nil)
    ("message-hook"		((regexp) (statement)) nil nil)
    ("my_hdr"			((string "Header")) nil nil)
    ("unmy_hdr"			((header)) t nil)
    ("push"			((string)) nil nil)
    ("pgp-hook"			((regexp)
				 (string "Keyid")) nil nil)
    ("save-hook"		((regexp) (path)) nil nil)
    ("score"			((regexp)
				 (number "Value")) nil nil)
    ("unscore"			((regexp)) t nil)
    ("send-hook"		((regexp) (statement)) nil nil)
    ("source"			((path)) nil nil)
    ("subscribe"		((address)) t nil)
    ("unsubscribe"		((address)) t nil)
    ("unhook"			((hook-type)) nil nil)
    ("alternates"		((regexp)) nil nil)
    ("unalternates"		((regexp)) nil nil))
  "List of muttrc commands with their arguments. Format is:
COMMAND '\(ARG1 ARG2 ...\) REPEAT OPTIONAL
REPEAT and OPTIONAL apply to the last argument.
ARGn is the list of arguments for muttrc-call-arg-handler. Each args
is a list \(ARGTYPE \[ARGNAME\]\).")

(defconst muttrc-statement-alist
  (append
   '(("set"			((assignment)) t nil)
     ("unset"			((variable)) t nil))
   muttrc-command-alist)
  "Additional muttrc commands with their arguments that are handled
differently. See muttrc-command-alist")


(defconst muttrc-variables-alist
  '(("abort_nosubject" quadoption "ask-yes")
    ("abort_unmodified" quadoption "yes")
    ("alias_file" path "~/.muttrc")
    ("alias_format" string "%4n %2f %t %-10a   %r")
    ("allow_8bit" boolean t)
    ("allow_ansi" boolean nil)
    ("arrow_cursor" boolean nil)
    ("ascii_chars" boolean nil)
    ("askbcc" boolean nil)
    ("askcc" boolean nil)
    ("assumed_charset" string "us-ascii")
    ("attach_format" string "%u%D%I %t%4n %T%.40d%> [%.7m/%.10M, %.6e%?C?, %C?, %s] ")
    ("attach_sep" string "\\n")
    ("attach_split" boolean t)
    ("attribution" string "On %d, %n wrote:")
    ("autoedit" boolean nil)
    ("auto_tag" boolean nil)
    ("beep" boolean t)
    ("beep_new" boolean nil)
    ("bounce" quadoption "ask-yes")
    ("bounce_delivered" boolean t)
    ("braille_friendly" boolean nil)
    ("charset" string "")
    ("check_new" boolean t)
    ("collapse_unread" boolean t)
    ("uncollapse_jump" boolean nil)
    ("compose_format" string "-- Mutt: Compose  [Approx. msg size: %l   Atts: %a]%>-")
    ("config_charset" string "")
    ("confirmappend" boolean t)
    ("confirmcreate" boolean t)
    ("connect_timeout" number 30)
    ("content_type" string "text/plain")
    ("copy" quadoption "yes")
    ("crypt_use_gpgme" boolean nil)
    ("crypt_autopgp" boolean t)
    ("crypt_autosmime" boolean t)
    ("date_format" string "!%a, %b %d, %Y at %I:%M:%S%p %Z")
    ("default_hook" string "~f %s !~P | (~P ~C %s)")
    ("delete" quadoption "ask-yes")
    ("delete_untag" boolean t)
    ("digest_collapse" boolean t)
    ("display_filter" path "")
    ("dotlock_program" path "/usr/bin/mutt_dotlock")
    ("dsn_notify" string "")
    ("dsn_return" string "")
    ("duplicate_threads" boolean t)
    ("edit_headers" boolean nil)
    ("editor" path "")
    ("encode_from" boolean nil)
    ("envelope_from_address" e-mail "")
    ("escape" string "~")
    ("fast_reply" boolean nil)
    ("fcc_attach" boolean t)
    ("fcc_clear" boolean nil)
    ("file_charset" string "")
    ("folder" path "~/Mail")
    ("folder_format" string "%2C %t %N %F %2l %-8.8u %-8.8g %8s %d %f")
    ("followup_to" boolean t)
    ("force_name" boolean nil)
    ("forward_decode" boolean t)
    ("forward_edit" quadoption "yes")
    ("forward_format" string "[%a: %s]")
    ("forward_quote" boolean nil)
    ("from" e-mail "")
    ("gecos_mask" regular "^[^,]*")
    ("hdrs" boolean t)
    ("header" boolean nil)
    ("help" boolean t)
    ("hidden_host" boolean nil)
    ("hide_limited" boolean nil)
    ("hide_missing" boolean t)
    ("hide_thread_subject" boolean t)
    ("hide_top_limited" boolean nil)
    ("hide_top_missing" boolean t)
    ("history" number 10)
    ("honor_followup_to" quadoption "yes")
    ("hostname" string "")
    ("ignore_list_reply_to" boolean nil)
    ("imap_authenticators" string "")
    ("imap_check_subscribed" boolean nil)
    ("imap_delim_chars" string "/.")
    ("imap_headers" string "")
    ("imap_home_namespace" string "")
    ("imap_idle" boolean nil)
    ("imap_keepalive" number 900)
    ("imap_list_subscribed" boolean nil)
    ("imap_login" string "")
    ("imap_pass" string "")
    ("imap_passive" boolean t)
    ("imap_peek" boolean t)
    ("imap_servernoise" boolean t)
    ("imap_user" string "")
    ("implicit_autoview" boolean nil)
    ("include" quadoption "ask-yes")
    ("include_onlyfirst" boolean nil)
    ("indent_string" string "> ")
    ("index_format" string "%4C %Z %{%b %d} %-15.15L (%?l?%4l&%4c?) %s")
    ("hdr_format" string "%4C %Z %{%b %d} %-15.15L (%?l?%4l&%4c?) %s")
    ("ispell" path "ispell")
    ("keep_flagged" boolean nil)
    ("locale" string "C")
    ("mail_check" number 5)
    ("mailcap_path" string "")
    ("mailcap_sanitize" boolean t)
    ("maildir_mtime" boolean nil)
    ("header_cache" path "")
    ("maildir_header_cache_verify" boolean t)
    ("header_cache_pagesize" string "16384")
    ("maildir_trash" boolean nil)
    ("mark_old" boolean t)
    ("markers" boolean t)
    ("mask" regular "!^\.[^.]")
    ("mbox" path "~/mbox")
    ("mbox_type" folder mbox)
    ("metoo" boolean nil)
    ("menu_context" number 0)
    ("menu_move_off" boolean t)
    ("menu_scroll" boolean nil)
    ("meta_key" boolean nil)
    ("mh_purge" boolean nil)
    ("mh_seq_flagged" string "flagged")
    ("mh_seq_replied" string "replied")
    ("mh_seq_unseen" string "unseen")
    ("mime_forward" quadoption "no")
    ("mime_forward_decode" boolean nil)
    ("mime_forward_rest" quadoption "yes")
    ("pgp_mime_signature_filename" string "signature.asc")
    ("pgp_mime_signature_description" string "Digital signature")
    ("mix_entry_format" string "%4n %c %-16s %a")
    ("mixmaster" path "mixmaster")
    ("move" quadoption "ask-no")
    ("message_cachedir" path "")
    ("message_format" string "%s")
    ("narrow_tree" boolean nil)
    ("net_inc" number 10)
    ("pager" path "builtin")
    ("pager_context" number 0)
    ("pager_format" string "-%Z- %C/%m: %-20.20n   %s")
    ("pager_index_lines" number 0)
    ("pager_stop" boolean nil)
    ("crypt_autosign" boolean nil)
    ("crypt_autoencrypt" boolean nil)
    ("pgp_ignore_subkeys" boolean t)
    ("crypt_replyencrypt" boolean t)
    ("crypt_replysign" boolean nil)
    ("crypt_replysignencrypted" boolean nil)
    ("crypt_timestamp" boolean t)
    ("pgp_use_gpg_agent" boolean nil)
    ("crypt_verify_sig" quadoption "yes")
    ("pgp_verify_sig" quadoption "yes")
    ("smime_is_default" boolean nil)
    ("smime_ask_cert_label" boolean t)
    ("smime_decrypt_use_default_key" boolean t)
    ("pgp_entry_format" string "%4n %t%f %4l/0x%k %-4a %2c %u")
    ("pgp_good_sign" regular "")
    ("pgp_check_exit" boolean t)
    ("pgp_long_ids" boolean nil)
    ("pgp_retainable_sigs" boolean nil)
    ("pgp_autoinline" boolean nil)
    ("pgp_replyinline" boolean nil)
    ("pgp_show_unusable" boolean t)
    ("pgp_sign_as" string "")
    ("pgp_strict_enc" boolean t)
    ("pgp_timeout" number 300)
    ("pgp_sort_keys" sort address)
    ("pgp_mime_auto" quadoption "ask-yes")
    ("pgp_auto_decode" boolean nil)
    ("pgp_decode_command" string "")
    ("pgp_getkeys_command" string "")
    ("pgp_verify_command" string "")
    ("pgp_decrypt_command" string "")
    ("pgp_clearsign_command" string "")
    ("pgp_sign_command" string "")
    ("pgp_encrypt_sign_command" string "")
    ("pgp_encrypt_only_command" string "")
    ("pgp_import_command" string "")
    ("pgp_export_command" string "")
    ("pgp_verify_key_command" string "")
    ("pgp_list_secring_command" string "")
    ("pgp_list_pubring_command" string "")
    ("forward_decrypt" boolean t)
    ("smime_timeout" number 300)
    ("smime_encrypt_with" string "")
    ("smime_keys" path "")
    ("smime_ca_location" path "")
    ("smime_certificates" path "")
    ("smime_decrypt_command" string "")
    ("smime_verify_command" string "")
    ("smime_verify_opaque_command" string "")
    ("smime_sign_command" string "")
    ("smime_sign_opaque_command" string "")
    ("smime_encrypt_command" string "")
    ("smime_pk7out_command" string "")
    ("smime_get_cert_command" string "")
    ("smime_get_signer_cert_command" string "")
    ("smime_import_cert_command" string "")
    ("smime_get_cert_email_command" string "")
    ("smime_default_key" string "")
    ("ssl_force_tls" boolean nil)
    ("ssl_starttls" quadoption "yes")
    ("certificate_file" path "~/.mutt_certificates")
    ("ssl_use_sslv3" boolean t)
    ("ssl_use_tlsv1" boolean t)
    ("ssl_min_dh_prime_bits" number 0)
    ("ssl_ca_certificates_file" path "")
    ("pipe_split" boolean nil)
    ("pipe_decode" boolean nil)
    ("pipe_sep" string "\\n")
    ("pop_authenticators" string "")
    ("pop_auth_try_all" boolean t)
    ("pop_checkinterval" number 60)
    ("pop_delete" quadoption "ask-no")
    ("pop_host" string "")
    ("pop_last" boolean nil)
    ("pop_reconnect" quadoption "ask-yes")
    ("pop_user" string "")
    ("pop_pass" string "")
    ("post_indent_string" string "")
    ("postpone" quadoption "ask-yes")
    ("postponed" path "~/postponed")
    ("preconnect" string "")
    ("print" quadoption "ask-no")
    ("print_command" path "lpr")
    ("print_decode" boolean t)
    ("print_split" boolean nil)
    ("prompt_after" boolean t)
    ("query_command" path "")
    ("quit" quadoption "yes")
    ("quote_regexp" regular "^([ \t]*[|>:}#])+")
    ("read_inc" number 10)
    ("read_only" boolean nil)
    ("realname" string "")
    ("recall" quadoption "ask-yes")
    ("record" path "~/sent")
    ("reply_regexp" regular "^(re([\[0-9\]+])*|aw):[ \t]*")
    ("reply_self" boolean nil)
    ("reply_to" quadoption "ask-yes")
    ("resolve" boolean t)
    ("reverse_alias" boolean nil)
    ("reverse_name" boolean nil)
    ("reverse_realname" boolean t)
    ("rfc2047_parameters" boolean nil)
    ("save_address" boolean nil)
    ("save_empty" boolean t)
    ("save_name" boolean nil)
    ("score" boolean t)
    ("score_threshold_delete" number -1)
    ("score_threshold_flag" number 9999)
    ("score_threshold_read" number -1)
    ("send_charset" string "us-ascii:iso-8859-1:utf-8")
    ("sendmail" path "/usr/sbin/sendmail -oem -oi")
    ("sendmail_wait" number 0)
    ("shell" path "")
    ("sig_dashes" boolean t)
    ("sig_on_top" boolean nil)
    ("signature" path "~/.signature")
    ("simple_search" string "~f %s | ~s %s")
    ("smart_wrap" boolean t)
    ("smileys" regular "(>From )|(:[-^]?[][)(><}{|/DP])")
    ("sleep_time" number 1)
    ("sort" sort date)
    ("sort_alias" sort alias)
    ("sort_aux" sort date)
    ("sort_browser" sort alpha)
    ("sort_re" boolean t)
    ("spam_separator" string ",")
    ("spoolfile" path "")
    ("status_chars" string "-*%A")
    ("status_format" string "-%r-Mutt: %f [Msgs:%?M?%M/?%m%?n? New:%n?%?o? Old:%o?%?d? Del:%d?%?F? Flag:%F?%?t? Tag:%t?%?p? Post:%p?%?b? Inc:%b?%?l? %l?]---(%s/%S)-%>-(%P)---")
    ("status_on_top" boolean nil)
    ("strict_mime" boolean t)
    ("strict_threads" boolean nil)
    ("suspend" boolean t)
    ("text_flowed" boolean nil)
    ("thread_received" boolean nil)
    ("thorough_search" boolean nil)
    ("tilde" boolean nil)
    ("timeout" number 600)
    ("tmpdir" path "")
    ("to_chars" string " +TCFL")
    ("tunnel" string "")
    ("use_8bitmime" boolean nil)
    ("use_domain" boolean t)
    ("use_envelope_from" boolean nil)
    ("use_from" boolean t)
    ("use_idn" boolean t)
    ("use_ipv6" boolean t)
    ("user_agent" boolean t)
    ("visual" path "")
    ("wait_key" boolean t)
    ("weed" boolean t)
    ("wrap_search" boolean t)
    ("wrapmargin" number 0)
    ("write_inc" number 10)
    ("write_bcc" boolean t)
    ("xterm_icon" string "M%?n?AIL&ail?")
    ("xterm_set_titles" boolean nil)
    ("xterm_title" string "Mutt with %?m?%m messages&no messages?%?n? [%n NEW]?"))
  "List of muttrc variables. Format is:
VARIABLE TYPE DEFAULT"
  )

(defconst muttrc-mutt-function-alist
  '(("attach-file" . 0)
    ("attach-key" . 1)
    ("attach-message" . 2)
    ("backspace" . 3)
    ("backward-char" . 4)
    ("bol" . 5)
    ("bottom-page" . 6)
    ("bounce-message" . 7)
    ("buffy-cycle" . 8)
    ("change-dir" . 9)
    ("change-folder" . 10)
    ("change-folder-readonly" . 11)
    ("check-new" . 12)
    ("clear-flag" . 13)
    ("complete" . 14)
    ("complete-query" . 15)
    ("copy-file" . 16)
    ("copy-message" . 17)
    ("create-alias" . 18)
    ("current-bottom" . 19)
    ("current-middle" . 20)
    ("current-top" . 21)
    ("decode-copy" . 22)
    ("decode-save" . 23)
    ("delete-char" . 24)
    ("delete-entry" . 25)
    ("delete-message" . 26)
    ("delete-pattern" . 27)
    ("delete-subthread" . 28)
    ("delete-thread" . 29)
    ("detach-file" . 30)
    ("display-address" . 31)
    ("display-message" . 32)
    ("display-toggle-weed" . 33)
    ("edit" . 34)
    ("edit-bcc" . 35)
    ("edit-cc" . 36)
    ("edit-description" . 37)
    ("edit-encoding" . 38)
    ("edit-fcc" . 39)
    ("edit-file" . 40)
    ("edit-from" . 41)
    ("edit-headers" . 42)
    ("edit-message" . 43)
    ("edit-mime" . 44)
    ("edit-reply-to" . 45)
    ("edit-subject" . 46)
    ("edit-to" . 47)
    ("edit-type" . 48)
    ("enter-command" . 49)
    ("enter-mask" . 50)
    ("eol" . 51)
    ("exit" . 52)
    ("extract-keys" . 53)
    ("fetch-mail" . 54)
    ("filter-entry" . 55)
    ("first-entry" . 56)
    ("flag-message" . 57)
    ("forget-passphrase" . 58)
    ("forward-char" . 59)
    ("forward-message" . 60)
    ("group-reply" . 61)
    ("half-down" . 62)
    ("half-up" . 63)
    ("help" . 64)
    ("history-down" . 65)
    ("history-up" . 66)
    ("ispell" . 67)
    ("jump" . 68)
    ("kill-eol" . 69)
    ("kill-line" . 70)
    ("kill-word" . 71)
    ("last-entry" . 72)
    ("limit" . 73)
    ("list-reply" . 74)
    ("mail" . 75)
    ("mail-key" . 76)
    ("mark-as-new" . 77)
    ("middle-page" . 78)
    ("new-mime" . 79)
    ("next-entry" . 80)
    ("next-line" . 81)
    ("next-new" . 82)
    ("next-page" . 83)
    ("next-subthread" . 84)
    ("next-thread" . 85)
    ("next-undeleted" . 86)
    ("next-unread" . 87)
    ("parent-message" . 88)
    ("pgp-menu" . 89)
    ("pipe-entry" . 90)
    ("pipe-message" . 91)
    ("postpone-message" . 92)
    ("previous-entry" . 93)
    ("previous-line" . 94)
    ("previous-new" . 95)
    ("previous-page" . 96)
    ("previous-subthread" . 97)
    ("previous-thread" . 98)
    ("previous-undeleted" . 99)
    ("previous-unread" . 100)
    ("print-entry" . 101)
    ("print-message" . 102)
    ("query" . 103)
    ("query-append" . 104)
    ("quit" . 105)
    ("quote-char" . 106)
    ("read-subthread" . 107)
    ("read-thread" . 108)
    ("recall-message" . 109)
    ("redraw-screen" . 110)
    ("refresh" . 111)
    ("rename-file" . 112)
    ("reply" . 113)
    ("save-entry" . 114)
    ("save-message" . 115)
    ("search" . 116)
    ("search-next" . 117)
    ("search-opposite" . 118)
    ("search-reverse" . 119)
    ("search-toggle" . 120)
    ("select-entry" . 121)
    ("select-new" . 122)
    ("send-message" . 123)
    ("set-flag" . 124)
    ("shell-escape" . 125)
    ("show-limit" . 126)
    ("show-version" . 127)
    ("skip-quoted" . 128)
    ("sort" . 129)
    ("sort-mailbox" . 130)
    ("sort-reverse" . 131)
    ("subscribe" . 132)
    ("sync-mailbox" . 133)
    ("tag-entry" . 134)
    ("tag-message" . 135)
    ("tag-pattern" . 136)
    ("tag-prefix" . 137)
    ("tag-thread" . 138)
    ("toggle-mailboxes" . 139)
    ("toggle-new" . 140)
    ("toggle-quoted" . 141)
    ("toggle-subscribed" . 142)
    ("toggle-unlink" . 143)
    ("toggle-write" . 144)
    ("top" . 145)
    ("top-page" . 146)
    ("undelete-entry" . 147)
    ("undelete-message" . 148)
    ("undelete-pattern" . 149)
    ("undelete-subthread" . 150)
    ("undelete-thread" . 151)
    ("unsubscribe" . 152)
    ("untag-pattern" . 153)
    ("verify-key" . 154)
    ("view-attach" . 155)
    ("view-attachments" . 156)
    ("view-file" . 157)
    ("view-mailcap" . 158)
    ("view-name" . 159)
    ("view-text" . 160)
    ("write-fcc" . 161))
  "List of Mutt command (not muttrc!)")

(defconst muttrc-alias-sort-order-alist
  '(("address" . 0) ("alias" . 1)  ("unsorted" . 2)))

(defconst muttrc-aux-sort-order-alist
  '(("date-sent" . 0) ("reverse-date-sent" . 1) ("last-date-sent" . 2)
    ("date-received" . 3) ("reverse-date-received" . 4)
    ("last-date-received" . 5)
    ("from" . 6) ("reverse-from" . 7) ("last-from" . 8)
    ("mailbox-order" . 9) ("reverse-mailbox-order" . 10)
    ("last-mailbox-order" . 11)
    ("score" . 12) ("reverse-score" . 13) ("last-score" . 14)
    ("size" . 15) ("reverse-size" . 16) ("last-size" . 17)
    ("subject" . 18) ("reverse-subject" . 19) ("last-subject" . 20)
    ("threads" . 21) ("reverse-threads" . 22) ("last-threads" . 23)
    ("to" . 24) ("reverse-to" . 25) ("last-to" . 26)))

(defconst muttrc-browser-sort-order-alist
  '(("alpha" . 0) ("date" . 1) ("size" . 2) ("unsorted" . 3)))

(defconst muttrc-pgp-sort-order-alist
  '(("address" . 0) ("date" . 1) ("keyid" . 2)
    ("reverse-address" . 3) ("reverse-date" . 4)
    ("reverse-keyid" . 5) ("reverse-trust" . 6)
    ("trust" . 7)))

(defconst muttrc-quadoption-alist
  '(("yes" .0) ("no" .1) ("ask-yes" .2) ("ask-no" .3)))

(defconst muttrc-sort-order-alist
  '(("date-sent" . 0) ("reverse-date-sent" . 1)
    ("date-received" . 2) ("reverse-date-received" . 3)
    ("from" . 4) ("reverse-from" . 5)
    ("mailbox-order" . 6) ("reverse-mailbox-order" . 7)
    ("score" . 8) ("reverse-score" . 9)
    ("size" . 10) ("reverse-size" . 11)
    ("subject" . 12) ("reverse-subject" . 13)
    ("threads" . 14) ("reverse-threads" . 15)
    ("to" . 16) ("reverse-to" . 17)))

;;; ------------------------------------------------------------
;;; Font-lock definitions
;;; ------------------------------------------------------------

(defun muttrc-string-regexp (quote-char)
  (let ((c (char-to-string quote-char)))
    (format "%s\\([^\n%s]\\|[\\].\\)*%s" c c c)))

(defvar muttrc-generic-arg-regexp
  (concat "\\("
	  (muttrc-string-regexp ?\")
	  "\\|"
	  "'\\([^']*\\)'"
	  "\\|"
	  (muttrc-string-regexp ?\`)
	  "\\|"
	  "\\([^\n\t \"'`#;\\]\\|[\\].\\)+"
	  "\\)"))

(defvar muttrc-generic-arg-sequence-regexp
  (concat "\\(\\s-*" muttrc-generic-arg-regexp "+\\)*"))

(defvar muttrc-non-command-keyword-regexp
  "\\(^\\|;\\)\\s-*\\<\\(set\\|unset\\|toggle\\|reset\\)\\>")

(defvar muttrc-variable-regexp
  (concat "\\<\\(\\(no\\|inv\\)?\\("
	  (mapconcat 'car muttrc-variables-alist "\\|")
	  "\\)\\)\\>"))

(defvar muttrc-assignement-regexp
  (concat muttrc-variable-regexp
	  "\\s-*\\(=\\s-*" muttrc-generic-arg-regexp "\\)?"))

(defun muttrc-search-command-forward (command &optional limit)
  (let ((cmd-desc (assoc command muttrc-command-alist)))
    (if cmd-desc
	(let ((cmd-match-data '())
	      (cmd-args (cadr cmd-desc))
	      (origin (point))
	      beg-0 end-0)
	  (catch 'done
	    (while (and (not cmd-match-data)
			(re-search-forward
			 (concat "\\(;\\|^\\)\\s-*\\(" command "\\)")
			 limit t))
	      (let ((beg (nth 4 (match-data)))
		    (end (nth 5 (match-data))))
		(setq beg-0 beg)
		(setq cmd-match-data (list beg end)))
	      (let ((args cmd-args))
		(while args
		  (let ((arg-type (caar args))
			(arg-re (if (null (cdr args))
				    muttrc-generic-arg-sequence-regexp
				  muttrc-generic-arg-regexp)))
		    (skip-syntax-forward "-")
		    (if (looking-at arg-re)
			(let ((beg (nth 0 (match-data)))
			      (end (nth 1 (match-data))))
			  (goto-char end)
			  (setq cmd-match-data (append cmd-match-data
						       (list beg end)))
			  (setq end-0 end)
			  (setq args (cdr args)))
		      (progn
			(setq args nil)
			(setq cmd-match-data nil)))))
		(when cmd-match-data
		  (set-match-data (cons beg-0
					(cons end-0
					      cmd-match-data)))
		  (throw 'done t))))
	    (goto-char origin)
	    nil)))))


(defun muttrc-font-lock-keywords ()
  (let ((command-alist muttrc-command-alist)
	keywords)
    (while command-alist
      (let* ((cmd (caar command-alist))
	     (args (cadr (car command-alist)))
	     (regexp (eval ; Simulate a closure
		      (list
		       'lambda '(&optional limit)
		       (list 'muttrc-search-command-forward cmd 'limit))))
	     (hilighters '((1 font-lock-keyword-face)))
	     (n 2))
	(while args
	  (let ((arg-type (caar args))
		(last-arg-p (null (cdr args))))
	    (setq hilighters
		  (append hilighters
			  (let ((face
				 (or (cdr-safe
				      (assoc arg-type
					     muttrc-argument-faces-alist))
				     'default)))
			    (list (append (list n (list 'quote face))
					  (if last-arg-p '(nil t))))))))
	  (setq n (1+ n))
	  (setq args (cdr args)))
	(setq keywords (append keywords (list (cons regexp hilighters))))
	(setq command-alist (cdr command-alist))))
     (append keywords
	     (list
	      (list muttrc-non-command-keyword-regexp 2
		    font-lock-keyword-face)
	      (list muttrc-assignement-regexp 1
		    font-lock-variable-name-face)))
    ))

;;; ------------------------------------------------------------
;;; Mode specific customization
;;; ------------------------------------------------------------

(defconst muttrc-mode-map nil
  "The keymap that is used in Muttrc mode.")
(if (null muttrc-mode-map)
    (setq muttrc-mode-map
	  (let ((map (make-sparse-keymap))
		(help-map (make-sparse-keymap))
		(ctrl-c-map (make-sparse-keymap)))
	    (define-key map "\C-c" ctrl-c-map)
	    (define-key ctrl-c-map "c" 'muttrc-insert-command)
	    (define-key ctrl-c-map "C" 'comment-region)
	    (define-key ctrl-c-map "s" 'muttrc-set-variable)
	    (define-key ctrl-c-map "S" 'muttrc-unset-variable)
	    (define-key ctrl-c-map "f" 'muttrc-find-variable-in-buffer)
	    (define-key ctrl-c-map "h" help-map)
	    (define-key help-map "m" 'muttrc-find-manual-file)
	    (define-key help-map "v" 'muttrc-find-variable-help)
	    (define-key help-map "c" 'muttrc-find-command-help)
	    map)))

(defvar muttrc-mode-syntax-table nil)
(when (null muttrc-mode-syntax-table)
  (setq muttrc-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry ?#  "<     " muttrc-mode-syntax-table)
  (modify-syntax-entry ?\n ">     " muttrc-mode-syntax-table)
  (modify-syntax-entry ?\' "$     " muttrc-mode-syntax-table)
  (modify-syntax-entry ?\' "$     " muttrc-mode-syntax-table)
  (modify-syntax-entry ?_  "w     " muttrc-mode-syntax-table)
  (modify-syntax-entry ?-  "w     " muttrc-mode-syntax-table)
  )

;;; ------------------------------------------------------------
;;; The mode function itself.
;;; ------------------------------------------------------------

;;;###autoload
(defun muttrc-mode ()
  "Major mode for editing Muttrc files.
This function ends by invoking the function(s) `muttrc-mode-hook'.

\\{muttrc-mode-map}
"

  (interactive)
  (kill-all-local-variables)

  ;; Font lock.
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults
	'('muttrc-font-lock-keywords
	  nil nil nil nil
	  (font-lock-syntactic-keywords . (("'[^'\n]*'" 0 "\"")))))

  ;; Comment stuff.
  (make-local-variable 'comment-start)
  (setq comment-start "#")
  (make-local-variable 'comment-end)
  (setq comment-end "")
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "#+[ \t]*")

  ;; become the current major mode
  (setq major-mode 'muttrc-mode)
  (setq mode-name "Muttrc")

  ;; Activate keymap and syntax table.
  (use-local-map muttrc-mode-map)
  (set-syntax-table muttrc-mode-syntax-table)

  (run-hooks 'muttrc-mode-hook))



;;; ------------------------------------------------------------
;;; Other functions
;;; ------------------------------------------------------------

(defun muttrc-perform-nonreg-test ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^# Begin\\s-+\\(.*\\)$" nil t)
      (let ((test-name (match-string-no-properties 1))
	    (expr ""))
	(catch 'loop
	  (while t
	    (or (= (forward-line 1) 0)
		(throw 'loop t))
	    (if (looking-at (format "^# End\\s-+%s\\s-*"
				    (regexp-quote test-name)))
		(throw 'loop t))
	    (if (looking-at "^# End\\s-+\\(.*\\)$")
		(error "Found end of %s before %s"
		       (match-string-no-properties 1) test-name))
	    (if (looking-at "^[^#]")
		(error "End of %s not found" test-name))
	    (if (looking-at "^#\\s-*\\(.*\\)$")
		(setq expr (concat expr (match-string-no-properties 1))))))
	(if (eval (read expr))
	    (message "Passed: %s" test-name)
	  (error "Failed: %s" test-name))))))

(defun muttrc-quote-string (s)
  "Add a backslash on quotes and surround by quotes if needed."
  (save-match-data
    (cond ((or (not s) (equal s "")) "''")
	  ((string-match "^[^']*\\s-[^']*$" s) (format "'%s'" s))
	  ((string-match "\\s-" s)
	   (concat "\""
		   (mapconcat (lambda (c)
				(if (eq c ?\") "\\\""
				  (char-to-string c)))
			      s "")
		   "\""))
	  (t s))))

(defun muttrc-prompt-string (prompt-base &optional default)
  (if default
      (format "%s [%s]: " prompt-base default)
    (format "%s: " prompt-base)))

(defun muttrc-token-around-point (alist &optional strip-fun)
  (let ((word (and (functionp 'thing-at-point)
		   (funcall (or strip-fun 'identity)
			    (funcall 'thing-at-point 'word)))))
    (if (and word (assoc word alist))
	word)))

(defun muttrc-assignement (varname modifier &optional value)
  (concat (format "%s%s" (or modifier "") varname)
	  (if (stringp value)
	      (format "=%s"
		      (muttrc-quote-string value))
	    "")))

(defun muttrc-split-next-set-line ()
  "Returns the current line splitted into tokens. The result is a list
of tokens like:
\((CMD START END) ((VAR1 MODIFIER1 ASSIGNMENT1 START END) ... REST)).
Last element REST is one string that is the rest of the line."
  (if (re-search-forward
       "^\\s-*\\(set\\|unset\\|toggle\\|reset\\)\\s-+" nil t)
      (let ((line (list (list (match-string-no-properties 1)
			      (match-beginning 1)
			      (match-end 1))))
	    (limit (save-excursion
		     (end-of-line)
		     (point))))
	(catch 'done
	  (while (< (point) limit)
	    (or (looking-at
		 (format "\\<\\(inv\\|no\\)?\\([a-z][a-z_]*\\)\\>"))
		(throw 'done t))
	    (let ((modifier (match-string-no-properties 1))
		  (varname (match-string-no-properties 2))
		  (assignment nil))
	      (goto-char (match-end 0))
	      (skip-syntax-forward "-" limit)
	      (if (or (looking-at		; Set without quote
		       "=\\s-*\\([^'\" \t\n#]+\\)")
		      (looking-at		; Set with double quote (")
		       "=\\s-*\"\\(\\([^\"\\]\\|\\\\.\\)*\\)\"")
		      (looking-at		; Set with single quote (')
		       "=\\s-*'\\([^']*\\)'"))
		  (let ((type (let ((desc (assoc varname
						 muttrc-variables-alist)))
				(if desc (cadr desc)))))
		    (if type
			(and (eq type 'boolean)
			     (message "%s: can't assign a boolean" varname))
		      (message "%s: unknown Muttrc variable"
			       varname))
		    (setq assignment (match-string-no-properties 1))
		    (goto-char (match-end 0))))
	      (nconc line (list (list varname modifier
				      assignment
				      (match-beginning 0)
				      (match-end 0))))
	      (skip-syntax-forward "-" limit))))
	(skip-syntax-backward "-")
	(if (looking-at ".+$")
	    (nconc line (list (list (match-string-no-properties 0)))))
	(end-of-line)
	line)))

(defun muttrc-splice-assignment (line varname)
  "Returns a list where assignements for VARNAME are separated from
assignment for other variables."
  (let ((l (cdr line))
	(in '())
	(out '()))
    (while (and l (consp (car l)))
      (let ((arg (car l)))
	(if (string= (car arg) varname)
	    (setq in (append in (list arg)))
	  (setq out (append out (list arg)))))
      (setq l (cdr l)))
    (list in out)))

(defun muttrc-new-value (cmd varname type modifier value default)
  (if (eq type 'boolean)
      (cond ((string= cmd "set")
	     (cond ((null modifier) t)
		   ((string= modifier "no") nil)
		   ((string= modifier "inv") (not value))))
	    ((string= cmd "unset")
	     (cond ((null modifier) nil)
		   ((string= modifier "no") t)
		   ((string= modifier "inv") value)))
	    ((string= cmd "toggle") (not value))
	    ((string= cmd "reset")
	     (cond ((null modifier) default)
		   ((string= modifier "no") (not default))
		   ((string= modifier "inv") (not default)))))
      (cond ((string= cmd "set") value)
	    ((string= cmd "unset") default)
	    ((string= cmd "toggle")
	     (error "%s: can't toggle non boolean" varname))
	    ((string= cmd "reset") default))))

(defun muttrc-get-value-and-point (varname)
  "Fetch the value of VARIABLE from the current buffer. It returns a
cons (VALUE . POINT) where POINT is the beginning of the line defining
VARNAME."
  (save-excursion
    (let ((var-descriptor (assoc varname muttrc-variables-alist)))
      (or var-descriptor
	  (error "%s: unknown variable." varname))
      (goto-char (point-min))
      (let ((type (nth 0 (cdr var-descriptor)))
	    (default (nth 1 (cdr var-descriptor)))
	    (pos nil))
	(let ((value default))
	  ;; We search all the definitions in the buffer because some
	  ;; users may use toggle or set inv...
	  (catch 'done
	    (while t
	      (let ((line (muttrc-split-next-set-line)))
		(or line (throw 'done t))
		(let ((cmd (caar line))
		      (assignments
		       (car (muttrc-splice-assignment line varname))))
		  (if assignments
		      (setq pos (save-excursion
				  (beginning-of-line)
				  (point))))
		  (while assignments
		    (let ((modifier (nth 1 (car assignments)))
			  (new-value (nth 2 (car assignments))))
		      (setq value
			    (muttrc-new-value cmd varname type modifier
					      (or new-value value)
					      default)))
		    (setq assignments (cdr assignments)))))))
	  (cons value pos))))))

(defun muttrc-get-value (varname)
  "Fetch the value of VARIABLE from the current buffer."
  (let ((value (muttrc-get-value-and-point varname)))
    (and value (car value))))

;;; ------------------------------------------------------------
;;; Viewing manual
;;; ------------------------------------------------------------

(defvar muttrc-manual-buffer-name "*Mutt Manual*")

(defun muttrc-find-manual-file-no-select ()
  "Convert overstriking and underlining to the correct fonts in a
file. The buffer does not visit the file."
  (interactive)
  (or (file-readable-p muttrc-manual-path)
      (error "%s: file not found" muttrc-manual-path))
  (let ((buf (get-buffer-create muttrc-manual-buffer-name)))
    (save-excursion
      (set-buffer buf)
      (if (not buffer-read-only)
	  (let ((insert-contents-fun
		 (condition-case nil
		     (and (require 'jka-compr)
			  'jka-compr-insert-file-contents)
		   (error 'insert-file-contents))))
	    (funcall insert-contents-fun muttrc-manual-path nil nil nil t)
	    (buffer-disable-undo buf)
	    (Man-fontify-manpage)
	    (set-buffer-modified-p nil)
	    (toggle-read-only)
	    (goto-char (point-min))))
      buf)))

(defun muttrc-find-manual-file ()
  "Convert overstriking and underlining to the correct fonts in a
file. The buffer does not visit the file."
  (interactive)
  (switch-to-buffer-other-window
   (muttrc-find-manual-file-no-select) t))

(defun muttrc-search-command-help-forward (command)
  (when (re-search-forward
	 (format "^[ \t]*Usage:\\s-*\\(\\[un\\]\\)?%s" command)
	 nil t)
    (goto-char (match-beginning 0))
    (forward-line -2)
    (point)))

(defun muttrc-search-variable-help-forward (command)
  (when (and (re-search-forward
	      (format "^[ \t]*%s\\.?\\s-*%s\\s-*$"
		      "\\([1-9][0-9.]*\\)"
		      (regexp-quote variable))
	      nil t)
	     (re-search-forward
	      (format "^[ \t]*%s\\.?\\s-*%s\\s-*$"
		      "\\([1-9][0-9.]*\\)"
		      (regexp-quote variable))
	      nil t)	     
	     (re-search-forward
	      (format "^[ \t]*%s\\.?\\s-*%s\\s-*$"
		      (regexp-quote (match-string-no-properties 1))
		      (regexp-quote variable))
	      nil t))
    (goto-char (match-beginning 0))
    (point)))

(defun muttrc-find-help (search-fun topic)
  "Find an help topic in the manual and display it. Returns the manual
buffer."
  (let ((buf (muttrc-find-manual-file-no-select)))
    (let ((win (get-buffer-window buf))
	  help-start)
      (save-excursion
	(set-buffer buf)
	(goto-char (point-min))
	(or (funcall search-fun topic)
	    (error "%s: entry not found in Mutt manual." command))
	(setq help-start (point))
	(unless (get-buffer-window buf)
	  (switch-to-buffer-other-window buf t))
	(set-window-start win help-start)))
    buf))

(defun muttrc-find-command-help (&optional command)
  (interactive
   (let ((word (muttrc-token-around-point muttrc-command-alist)))
     (list (muttrc-get-from-list "Command" word 'muttrc-command-alist t))))
  (muttrc-find-help 'muttrc-search-command-help-forward
		    (if (string-match "^un\\(.*\\)$" command)
			(match-string-no-properties 1 command)
		      command)))

(defun muttrc-find-variable-help (&optional variable)
  (interactive
   (list
    (let ((word (muttrc-token-around-point
		 muttrc-variables-alist
		 (function
		  (lambda (word)
		    (if (and word
			     (string-match "^\\(no\\|inv\\)\\(.*\\)$" word))
			(match-string-no-properties 2 word)
		      word))))))
      (muttrc-get-from-list "Variable" word 'muttrc-variables-alist))))
  (muttrc-find-help 'muttrc-search-variable-help-forward variable))

(defun muttrc-bury-manual-buffer ()
  (let ((buf (get-buffer muttrc-manual-buffer-name)))
    (if buf (bury-buffer buf))))

;;; ------------------------------------------------------------
;;; Argument handlers
;;; ------------------------------------------------------------

(defun muttrc-call-arg-handler (key default &optional prompt)
  "Call the function that properly prompts for an argument type."
  (let ((handler-args (assoc key muttrc-arg-handler-alist)))
    (or handler-args
	(error "%s: unknown argument type." (symbol-name key)))
    (let ((cmd (nth 0 (cdr handler-args)))
	  (default-prompt (nth 1 (cdr handler-args)))
	  (args (cdr (cddr handler-args))))
      (apply cmd (or prompt default-prompt) default args))))

(defun muttrc-get-boolean (prompt &optional default)
  "Prompt for a boolean."
  (y-or-n-p (format "%s? " prompt)))

(defun muttrc-get-number (prompt default)
  "Prompt for a string and return DEFAULT if the string is empty"
  (or (read-from-minibuffer (muttrc-prompt-string prompt default))
      default))

(defun muttrc-get-string (prompt default)
  "Prompt for a string and return DEFAULT if the string is empty"
  (let ((s (read-from-minibuffer (muttrc-prompt-string prompt default))))
    (if (> (length s) 0) s default)))

(defun muttrc-get-word (prompt default)
  "Prompt for a word and return DEFAULT if it is empty"
  (let ((s (read-from-minibuffer (muttrc-prompt-string prompt default))))
    (or (string-match "^\\w*$" s)
	(error "%s: invalid entry, expecting a word" s))
    (if (> (length s) 0) s default)))

(defun muttrc-get-from-list (prompt default list &optional require-match)
  "Prompt for a string from list and return DEFAULT if the string is empty"
  (let ((s (completing-read (muttrc-prompt-string prompt default)
			    (symbol-value list)
			    nil require-match)))
    (if (> (length s) 0) s default)))

(defun muttrc-get-path (prompt default)
  "Prompt for a path and return DEFAULT if the string is empty. The
muttrc folder prefix is replaced by MUTTRC-FOLDER-ABBREV."
  (let* ((folder (muttrc-get-value "folder"))
	 (path (read-file-name (muttrc-prompt-string prompt default)
			       folder folder)))
    (let ((compacted-path
	   (if (string-match (format "^%s/?\\(.*\\)$" (regexp-quote folder))
			     path)
	       (format "%s%s"
		       (char-to-string muttrc-folder-abbrev)
		       (match-string-no-properties 1 path))
	     path)))
      (if (not (string= compacted-path
			(char-to-string muttrc-folder-abbrev)))
	  compacted-path
	default))))

(defun muttrc-get-assignment (&optional prompt default
					with-value-p)
  (let ((varname (completing-read (muttrc-prompt-string prompt default)
				  muttrc-variables-alist)))
    (if (assoc varname muttrc-variables-alist)
	(let* ((type (cadr (assoc varname muttrc-variables-alist)))
	       (default (car-safe (muttrc-get-value-and-point varname)))
	       (value (if with-value-p
			(muttrc-call-arg-handler type default "Value"))))
	  (if with-value-p
	      (muttrc-assignement varname
				  (and (eq type 'boolean)
				       (not value)
				       "no")
				  value)
	    varname))
      default)))

;;; ------------------------------------------------------------
;;; Commands insertion
;;; ------------------------------------------------------------

(defun muttrc-get-command (&optional prompt default)
  "Prompts the usr for a command to enter and asks for all the arguments."
  (let* ((cmd (muttrc-get-from-list "Command" nil 'muttrc-command-alist t))
	 (cmd-descriptor (cdr (assoc cmd muttrc-command-alist)))
	 (arg-list-type (nth 0 cmd-descriptor))
	 (repeat-p (nth 1 cmd-descriptor))
	 (optional-p (nth 2 cmd-descriptor))
	 (arg-list-value (list cmd)))
    (save-window-excursion
      (if (and muttrc-display-help)
	  (save-excursion
	    (muttrc-find-command-help cmd)))
      (while arg-list-type
	(let* ((arg-type (caar arg-list-type))
	       (arg (apply 'muttrc-call-arg-handler
			   (append (list arg-type nil)
				   (cdar arg-list-type)))))
	  (if arg
	      (progn
		(nconc arg-list-value
		       (list (if (eq arg-type 'assignment)
				 arg ; assignment are quoted by handler
			       (muttrc-quote-string arg))))
		(if (and repeat-p
			 (null (cdr arg-list-type)))
		    (setq optional-p t)
		  (setq arg-list-type (cdr arg-list-type))))
	    (if (and (null (cdr arg-list-type))
		     optional-p)
		(setq arg-list-type nil)
	      (error "Argument required"))))))
    (muttrc-bury-manual-buffer)
    (mapconcat 'identity arg-list-value " ")))

(defun muttrc-get-statement (&optional prompt default)
  (let ((muttrc-command-alist muttrc-statement-alist))
    (muttrc-get-command prompt default)))

(defun muttrc-insert-command ()
  "Insert a muttrc command on the current line."
  (interactive)
  (let ((cmd-line (muttrc-get-command)))
    (beginning-of-line)
    (or (eolp) (forward-line 1))
    (insert cmd-line)
    (newline)))

;;; ------------------------------------------------------------
;;; Setting variables
;;; ------------------------------------------------------------

(defun muttrc-update-current-line (varname type &optional value)
  "Rewrites the current line by setting VARNAME to VALUE. If the
statement is not \"set\", the variable is removed. In set statement,
it is removed if the value is NIL and the variable is not a boolean.
The function returns t is the variable is really assigned in the line."
  (let* ((line (muttrc-split-next-set-line))
	 (cmd (caar line))
	 (kill-whole-line t)
	 (args "")
	 (set-p nil))
    (beginning-of-line)
    (kill-line)
    (let ((l (cdr line)))
      (while l
	(let ((elt (car l)))
	  (if (consp elt)
	      (let ((this-var (nth 0 elt))
		    (this-modifier (nth 1 elt))
		    (this-value (nth 2 elt)))
		(let ((assignement
		       (if (string= this-var varname)
			   (when (string= cmd "set")
			     (setq set-p t)
			     (cond ((eq type 'boolean)
				    (muttrc-assignement varname
							(if (not value) "no")
							value))
				   (value
				    (muttrc-assignement varname nil value))
				   (t (setq set-p nil))))
			 (muttrc-assignement this-var
					     this-modifier
					     this-value))))
		  (if assignement
		      (setq args (concat args " " assignement)))))
	    (setq args (concat args elt))))
	(setq l (cdr l))))
    (when (not (string= args ""))
      (insert cmd)
      (insert args)
      (newline))
    (backward-char 1)
    set-p))

(defun muttrc-update-variable (varname type value pos)
  (catch 'done
    (when pos
      (goto-char pos)
      (if (muttrc-update-current-line varname type value)
	  (throw 'done t)))
    (end-of-line)
    (let ((cr-after-p (bolp))
	  (cmd (if (or value (eq type 'boolean)) "set" "unset"))
	  (modifier (if (and (not value) (eq type 'boolean)) "no")))
      (or cr-after-p (newline))
      (insert cmd " "
	      (muttrc-assignement varname modifier value))
      (if cr-after-p (newline))))
  t)

(defun muttrc-set-variable (&optional varname type value pos)
  (interactive
   (let* ((varname (muttrc-get-from-list "Variable" nil
					 'muttrc-variables-alist t))
	  (type (cadr (assoc varname muttrc-variables-alist)))
	  (default (muttrc-get-value-and-point varname)))
     (list varname type
	   (save-window-excursion
	     (if muttrc-display-help
		 (save-excursion
		   (muttrc-find-variable-help varname)))
	     (muttrc-call-arg-handler type (car default)))
	   (cdr default))))
  (muttrc-bury-manual-buffer)
  (muttrc-update-variable varname type value pos))

(defun muttrc-unset-variable (&optional varname type pos)
  (interactive
   (let* ((varname (muttrc-get-from-list "Variable" nil
					 'muttrc-variables-alist t))
	  (type (cadr (assoc varname muttrc-variables-alist)))
	  (default (muttrc-get-value-and-point varname)))
     (list varname type (cdr default))))
  (muttrc-update-variable varname type nil pos))

(defun muttrc-find-variable-in-buffer (&optional varname)
  (interactive
   (list (muttrc-get-from-list "Variable" nil
			       'muttrc-variables-alist t)))
  (let* ((var-info (muttrc-get-value-and-point varname))
	 (value (car var-info))
	 (pos (cdr-safe var-info)))
    (if pos
	(goto-char pos)
      (progn
	(message "%s: variable not set (default: %s)" varname value)))))

;;; ------------------------------------------------------------
;;; Almost the end
;;; ------------------------------------------------------------

(provide 'muttrc-mode)

;;; muttrc-mode.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/maplev.texi0000775000000000000000000012770312230377265021437 0ustar  \input texinfo
@c {{{ Header }}}

@setfilename maplev
@settitle MapleV Emacs Mode @value{EDITION}

@dircategory Emacs
@direntry
* maplev: (maplev). MapleV Emacs Mode
@end direntry

@c P.S. Galbraith: I don't have this file...
@c @include version.texi

@iftex
@tolerance 10000
@end iftex

@c $Id: maplev.texi,v 1.7 2011-06-24 18:27:08 psg Exp $

@ifinfo
This file documents MapleV, a GNU Emacs major mode for developing code for
Maple, a computer algebra system (CAS) produced by Waterloo Maple Inc.

Copyright (C) 1999
Joseph S. Riel

This edition is for MapleV version @value{EDITION}.

Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
are preserved on all copies.

@ignore
Permission is granted to process this file through TeX and print the
results, provided the printed document carries copying permission
notice identical to this one except for the removal of this paragraph
(this paragraph not being relevant to the printed manual).

@end ignore
Permission is granted to copy and distribute modified versions of this
manual under the conditions for verbatim copying, provided that the entire
resulting derived work is distributed under the terms of a permission
notice identical to this one.

Permission is granted to copy and distribute translations of this manual
into another language, under the above conditions for modified versions,
except that this permission notice may be stated in a translation approved
by the Free Software Foundation.
@end ifinfo

@c {{{endfold}}}
@c {{{ Titlepage and Copyright }}}

@setchapternewpage on

@titlepage
@title MapleV
@subtitle A GNU Emacs Mode for Maple Developers
@subtitle Edition @value{EDITION}, for MapleV Version @value{VERSION}
@subtitle @value{UPDATED}
  
@author Joseph S.@ Riel
@page
@vskip 0pt plus 1filll
Maple is a registered trademarks of Waterloo Maple Inc.@*

Copyright @copyright{} 1999 Joseph S. Riel@*
 
Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
are preserved on all copies.

@ignore
Permission is granted to process this file through TeX and print the
results, provided the printed document carries copying permission
notice identical to this one except for the removal of this paragraph
(this paragraph not being relevant to the printed manual).
@end ignore

Permission is granted to copy and distribute modified versions of this
manual under the conditions for verbatim copying, provided also that the
section entitled ``Copying'' is included exactly as in the original, and
provided that the entire resulting derived work is distributed under the
terms of a permission notice identical to this one.

Permission is granted to copy and distribute translations of this manual
into another language, under the above conditions for modified versions,
except that this permission notice may be stated in a translation
approved by the Free Software Foundation.
@end titlepage
@page

@c {{{endfold}}}
@c {{{ Top Node and Master Menu }}}

@ifinfo
@node top, Copying, (dir), (dir)
@top MapleV

MapleV is a GNU Emacs major mode for developing source code for @w{Maple}, 
a computer algebra system (CAS) marketed by @w{Waterloo Maple Inc}.
In this manual @dfn{MapleV} refers to the Emacs major mode and
@dfn{Maple} to the CAS.  MapleV is written entirely in Emacs-Lisp and is
distributed under the GNU General Public License.

This is the documentation for MapleV version @value{VERSION}.

@end ifinfo

@menu
* Copying::                     Conditions for copying and changing MapleV.
* Introduction::                A brief tour of MapleV's features.
* Basics::                      A few basics.

Editing

* Indentation::                 Indenting Maple code.
* Font Lock::                   Syntactic highlighting of Maple code.
* Comments::                    Command for adding and aligning comments.
* Shortcuts::                   Abbreviations and templates.
* Imenu support::               Creating a procedure index.

Processes

* Mint::                        Syntax checking.
* Maple::                       Running Maple as a standalone process.
* Help pages::                  Displaying Maple help pages.
* Procedures::                  Displaying procedures from the Maple libraries.

Appendices

* Installation::                Installing MapleV.
* Evolution::                   Credits, Bugs, Enhancements.

Indices

* Key Index::                   
* Function Index::              
* Variable Index::              
* Concept Index::               

@detailmenu
 --- The Detailed Node Listing ---

Indentation

* Indentation Commands::        Commands for inserting and aligning comments.
* Customizing Indentation::     Variables that affect indentation.
* Indentation Tricks::          Forcing and preventing indentation.
* Indentation Details::         Overview of the indentation algorithm.

Indentation Tricks

* Forcing indentation::         Using parentheses to force indentation.
* Preventing indentation::      Using continued comments to prevent indentation.

Font Lock

* Decoration level::            Selecting the decoration level.
* Adding keywords::             Customizing the font lock patterns.
* Display faces::               Setting the display faces.

Shortcuts

* Abbreviations::               Abbreviations for common Maple functions.
* Templates::                   Inserting procedures and assignments.

Abbreviations

* Customizing Abbreviations::   

Mint

* Running mint::                Commands for sending code to Mint.
* Mint mode::                   Mode for viewing the output of Mint.

Maple

* Running Maple::               Commands for sending code to the Maple engine.
* Cmaple mode::                 Mode for interacting with Maple.

Help pages

* Displaying help pages::       Commands for displaying Maple help pages.
* MapleV help mode::            Mode for viewing Maple help pages.

Procedures

* Displaying procedures::       Commands to display Maple procedures.
* MapleV proc mode::            Mode for viewing Maple procedures.

Installation

* Compiling::                   Byte compiling MapleV.
* Customizing::                 Customizing the installation.
* Info documentation::          Installing the Info documentation.

Evolution

* Bugs::                        
* Acknowledgments::             
* Enhancements::                

@end detailmenu
@end menu

@c {{{endfold}}}
@c {{{ Copying }}}

@node Copying, Introduction, top, top
@unnumbered Copying
@cindex Copying
@cindex Copyright
@cindex GPL
@cindex General Public License
@cindex License
@cindex Free
@cindex Free software
@cindex Distribution
@cindex Right
@cindex Warranty

The programs currently being distributed that relate to MapleV consist
of GNU Emacs Elisp files.  These programs are "free"; this means that
everyone is free to use them and free to redistribute them on a free
basis.  The MapleV-related programs are not in the public domain; they
are copyrighted and there are restrictions on their distribution, but
these restrictions are designed to permit everything that a good
cooperating citizen would want to do.  What is not allowed is to try to
prevent others from further sharing any version of these programs that
they might get from you.

Specifically, we want to make sure that you have the right to give
away copies of the programs that relate to MapleV, that you receive
source code or else can get it if you want it, that you can change these
programs or use pieces of them in new free programs, and that you know
you can do these things.

To make sure that everyone has such rights, we have to forbid you to
deprive anyone else of these rights.  For example, if you distribute
copies of the MapleV related programs, you must give the recipients all
the rights that you have.  You must make sure that they, too, receive or
can get the source code.  And you must tell them their rights.

Also, for our own protection, we must make certain that everyone finds
out that there is no warranty for the programs that relate to MapleV.
If these programs are modified by someone else and passed on, we want
their recipients to know that what they have is not what we distributed,
so that any problems introduced by others will not reflect on our
reputation.

The precise conditions of the licenses for the programs currently
being distributed that relate to MapleV are found in the General Public
Licenses that accompany them.



@c {{{endfold}}}
@c {{{ Introduction }}}
@node Introduction, Basics, Copying, top
@unnumbered Introduction
@cindex Introduction

@iftex
MapleV is a GNU Emacs major mode for developing source code for @w{Maple
V}, a computer algebra system (CAS) owned by @w{Waterloo Maple Inc}.  In
this manual @dfn{MapleV} refers to the Emacs major mode and @dfn{Maple}
to the CAS.  MapleV is written entirely in Emacs-Lisp and is distributed
under the GNU General Public License.
@end iftex

Following is a brief tour of MapleV's major features.

@heading Indentation

Maple source code is grammatically indented, either as you enter it or
all at once.  Customizable variables permit a limited control of the
indentation style.  The default settings produce a result that is very
close to the pretty printed output of Maple.

@heading Font Lock

Maple reserved words, special words, initial variables, builtin
functions, and top-level procedure assignments are font locked.
Comments and quotes are syntactically highlighted.  The amount of
``decoration'' can be customized.

@heading Comments

Commands are provided for inserting and aligning Maple comments.
Auto-filling can be enabled so that comments automatically wrap.

@heading Shortcuts

Abbreviations for common Maple words are defined and automatically
expanded, if enabled.  A blank procedure template, including your
copyright statement, can be inserted into the source.  It queries for
the name of the procedure, optional arguments, and a description.

@heading Mint interface

All or portions of the buffer can be sent to @code{mint}, Maple's syntax
checker.  The output is displayed in a buffer with a mode that
highlights and activates warnings and error messages.  Clicking on the
activated text either moves the cursor to the appropriate point in the
source code or queries to automatically correct the error.

@heading Maple interface

All or portions of the buffer can be sent to the command line version of
Maple, which is run in its own buffer.  You can work directly in that
buffer to exercise the source code.

@heading Online help

Help pages from Maple help databases can be called up and displayed in a
buffer.  The buffer has a mode that font locks section headings and
provides commands for viewing other help pages and recalling previously
visited pages.

@heading Library procedures

Procedures from Maple libraries can be displayed in a buffer.  They are
font locked the same as in a MapleV buffer.  Commands are
available for displaying other procedures and a history mechanism
provides a convenient means to return to previously displayed
procedures.

@heading Multiple Maple releases

At installation MapleV is configured to work with a default release of
Maple.  You may also specify alternate releases of Maple.  A MapleV
buffer can then be configured to work with a release different than the
default; it will access the versions of Maple and Mint appropriate for
the release.




@c {{{endfold}}}

@c {{{ Basics }}}

@node Basics, Indentation, Introduction, top
@chapter Basics
@cindex Top-level procedures
@cindex Menubar

For MapleV to properly locate, fontify, and index @dfn{top-level
procedures}, that is, non-nested procedure assignments, the procedure
name @emph{must} be flush left.  Indenting the buffer moves top-level
procedures to the left margin.

There are a few exceptional cases in which what should be top-level
procedures are, in fact, not.  The primary example is a Maple script in
which procedures are conditionally assigned.  See @ref{Preventing
indentation}, for an illustration and a method to automatically indent
these procedures to the left column.

Most of the higher-level MapleV functions, those that do more than edit
text, are available on the menubar.


@c {{{endfold}}}

@c {{{ Indentation }}}

@node Indentation, Font Lock, Basics, top
@comment  node-name,  next,  previous,  up
@chapter Indentation
@cindex Indentation

Maple source code is indented according to its grammar.  The indentation
can occur either as you enter the code or all at once; the latter action
is useful when working with non-indented source code.  A grammatical
error, typically an out of place keyword or parenthesis, generates an
error and moves the cursor to the place where the error was detected.

@menu
* Indentation Commands::        Commands for inserting and aligning comments.
* Customizing Indentation::     Variables that affect indentation.
* Indentation Tricks::          Forcing and preventing indentation.
* Indentation Details::         Overview of the indentation algorithm.
@end menu

@c {{{   commands }}}

@node Indentation Commands, Customizing Indentation, Indentation, Indentation
@comment  node-name,  next,  previous,  up
@section Commands

@cindex Indentation commands
@cindex Commands, indentation

@kindex C-j
@kindex C-c @key{TAB} @key{TAB}
@kindex C-c @key{TAB} b
@kindex C-c @key{TAB} p
@kindex C-c @key{TAB} r

@findex maplev-electric-tab
@findex maplev-indent-newline
@findex maplev-indent-buffer
@findex maplev-indent-procedure
@findex maplev-indent-region

@table @kbd
@item @key{TAB}
Indent the current line (@code{maplev-electric-tab}).

@item C-j
Indent the current line, insert a new line, and indent that line
(@code{maplev-indent-newline}).

@item C-c @key{TAB} @key{TAB}
@itemx C-c @key{TAB} b
Indent the buffer (@code{maplev-indent-buffer}).

@item C-c @key{TAB} p
Indent a procedure (@code{maplev-indent-procedure}).

@item C-c @key{TAB} r
Indent the region (@code{maplev-indent-region}).

@end table

@c {{{endfold}}}
@c {{{   customizing }}}

@node Customizing Indentation, Indentation Tricks, Indentation Commands, Indentation
@comment  node-name,  next,  previous,  up
@section Customizing
@cindex Customizing indentation
@cindex Indentation, customizing

The following variables affect indentation:

@vtable @code
@item maplev-indent-level
The amount a subblock is indented. The default is 4.

@item maplev-indent-declaration
The amount the Maple procedure declarations (@code{local},
@code{global}, @code{option}, and @code{description}) are indented.  The
default is 0.

@item maplev-dont-indent-re
A regex or nil.  If non-nil then lines that begin with a match are not
indented.  The default, @samp{"#"}, prevents flush left comment lines
from being indented.

@end vtable

@c {{{endfold}}}
@c {{{   tricks }}}

@node Indentation Tricks, Indentation Details, Customizing Indentation, Indentation
@section Indentation Tricks

The indentation algorithm is not perfect.  It can fail to indent code
that should be indented or it may indent code that should not be
indented.  The following sections give examples and demonstrate workarounds.

@menu
* Forcing indentation::         Using parentheses to force indentation.
* Preventing indentation::      Using continued comments to prevent indentation.
@end menu

@c {{{   forcing indentation }}}

@node Forcing indentation, Preventing indentation, Indentation Tricks, Indentation Tricks
@subsection Forcing indentation
@cindex Forcing indentation
@cindex Indentation, forcing
@cindex Indenting continued expressions
@cindex Continued expression, indenting

MapleV's indentation algorithm does not (currently) handle continued
expressions.  It aligns continuations with the left most
character in the preceding line.  In an assignment it is preferable to
align with the right side of the assignment.  

@subsubheading Problem

Indenting the following code causes the continued line to be left
aligned with the preceding line, as the following illustrates:

@example
---------- Buffer: foo ----------
y := a + ( ... ) 
     + b;@point{}
---------- Buffer: foo ----------

@key{TAB}
   @result{}
---------- Buffer: foo ----------
y := a + ( ... ) 
+ b;@point{}
---------- Buffer: foo ----------        
@end example

@subsubheading Solution

Use extra parentheses to prevent the continuation line from being
aligned with the opening column:

@example
---------- Buffer: foo ----------
y := ( a + ( ... ) 
       + b );
---------- Buffer: foo ----------
@end example

@c {{{endfold}}}
@c {{{   preventing indentation }}}

@node Preventing indentation,  , Forcing indentation, Indentation Tricks
@subsection Preventing indentation
@cindex Preventing indentation
@cindex Indentation, preventing
@subsubheading Problem

Consider an installation script in which the procedures @samp{foo1} and
@samp{foo2} are assigned only when the flag @code{assign_procs} is
@samp{true}.  The following example shows what happens when the buffer
is indented.

@example
@group
---------- Buffer: foo ----------
if assign_procs then
foo1 := proc() ... end:
foo2 := proc() ... end:
fi:
---------- Buffer: foo ----------

@kbd{M-x maplev-indent-buffer}
   @result{}
---------- Buffer: foo ----------
if assign_procs then
    foo1 := proc() ... end:
    foo2 := proc() ... end:
fi:
---------- Buffer: foo ----------
@end group
@end example


Because @code{foo1} and @code{foo2} are no longer flush left they are
not recognized as top-level procedures.  Their names are not properly
font locked and MapleV commands that operate on top-level procedures do
not work on them.

@subsubheading Solution

Because MapleV ignores comment continuations that Maple respects
(@ref{Comments}), we can use the following technique to prevent
@samp{foo1} and @samp{foo2} from being indented.

@example
@group
---------- Buffer: foo ----------
if assign_procs then       #\
fi                         # @r{Maple does not see this line}
foo1 := proc() ... end:
foo2 := proc() ... end:
#\
if then                    # @r{Maple does not see this line}
fi:
---------- Buffer: foo ----------
@end group
@end example

MapleV ignores the comment continuations and determines that each
@code{if} statement is completed on the following line.  The procedures
@code{foo1} and @code{foo2} are not indented.  Maple, however, continues
the comments and so matches the initial @code{if} to the final
@code{fi}; it ignores the dummy statements.

@c {{{endfold}}}


@c {{{endfold}}}
@c {{{   details }}}

@node Indentation Details,  , Indentation Tricks, Indentation
@section Indentation Details
@cindex Indentation details
@cindex Details, indentations
@cindex Indentation grammar
@cindex Grammar, indentation
@cindex Indenting, speed of
@cindex Speed of, indenting

A grammar table (@code{maplev--grammar-alist}) defines the grammar
used to indent Maple code.

MapleV parses the source to compute the appropriate indentation for each
line.  To speed this process, information from the last parse is saved
and reused.  This method allows it to indent entire buffers reasonably
quickly; the largest file in the Maple R5 share library
(@file{gdev.mpl}, 160K, by Bruno Salvy) took twelve seconds to indent on
a PC running NTEmacs.  During editing, if the buffer is modified above
the last indentation location then the indentation information is lost;
consequently, you may occasionally notice small delays as the source is
reparsed.

@c {{{endfold}}}

@c {{{endfold}}}
@c {{{ Font Lock }}}

@node Font Lock, Comments, Indentation, top
@chapter Font Lock
@cindex Font lock


@menu
* Decoration level::            Selecting the decoration level.
* Adding keywords::             Customizing the font lock patterns.
* Display faces::               Setting the display faces.
@end menu

@c {{{   decoration level }}}

@node Decoration level, Adding keywords, Font Lock, Font Lock
@section Decoration level
@cindex Font lock, decoration level
@cindex Decoration level, font lock
@cindex Maximum decoration, font lock

@vindex font-lock-maximum-decoration
@findex maplev-reset-font-lock

The amount of syntactical highlighting, or ``decoration'', is controlled
by the global variable @code{font-lock-maximum-decoration}, which you
may set in your @file{.emacs} file.  @inforef{Font Lock,,emacs}, for
information.  MapleV mode provides three levels of decoration:

@enumerate
@item 
Comments, quotes, top-level procedure names and Maple reserved works
are highlighted.

@item 
Everything in level 1 plus Maple special words, initial variables, and
the ditto operators are highlighted.

@item
Everything in level 2 plus Maple builtin functions are highlighted.

@end enumerate

Execute @kbd{M-x maplev-reset-font-lock @key{RET} LEVEL @key{RET}} or
use the menubar, @kbd{MapleV -> Setup -> Decoration}, to change the
decoration in a MapleV buffer.  @code{LEVEL} is an integer from 1 to 3.

@c {{{endfold}}}
@c {{{   adding keywords }}}


@node Adding keywords, Display faces, Decoration level, Font Lock
@section Adding keywords
@cindex Font lock, adding keywords
@cindex Keywords, font locking
@cindex Customizing font lock keywords

You can use the usual method to add new keywords to font lock in MapleV
mode.  For example, the following snippet can be added to your
@file{.emacs} file to font lock @samp{simplify} and @samp{printf} in
MapleV mode.

@example
(font-lock-add-keywords 
 'maplev-mode
 '(("simplify" . maplev-font-special-word-face)
   ("printf"   . maplev-font-special-word-face)))
@end example

@c {{{endfold}}}
@c {{{   faces }}}

@node Display faces,  , Adding keywords, Font Lock
@section Display faces
@cindex Font lock, display faces
@cindex Font lock, faces
@cindex Faces, font lock
@cindex Display faces, font lock

@vtable @code
@item maplev-special-word-face
Display face used for Maple special words.  The special words are
@samp{args}, @samp{nargs}, @samp{procname}, @samp{RootOf} and
@samp{Float}.

@item maplev-initial-variable-face
Display face used for Maple initial variables.  These are
@samp{Catalan}, @samp{true}, @samp{false}, @samp{FAIL}, @samp{infinity},
@samp{Pi}, @samp{gamma}, @samp{integrate}, @samp{libname}, @samp{NULL},
@samp{Order}, @samp{printlevel}, and @samp{lasterror}.

@end vtable

@c {{{endfold}}}

@c {{{endfold}}}
@c {{{ Comments }}}

@node Comments, Shortcuts, Font Lock, top
@chapter Comments

@cindex Comments

@kindex M-;
@kindex C-x ;
@kindex C-u - C-x ;
@kindex M-q

@findex indent-for-comment
@findex set-comment-column
@findex kill-comment
@findex fill-paragraph

@vindex comment-column
@vindex fill-column


MapleV uses standard Emacs commands to enter, align and fill Maple
comments.  @inforef{Comments,,emacs}. The commands are reproduced here
for convenience.

@table @kbd
@item M-; 
Insert or align an inline comment (@code{indent-for-comment}).  The
comment character is inserted at column @code{comment-column}.

@item C-x ;
Set comment column (@code{set-comment-column}).

@item C-u - C-x ;
Kill comment on current line (@code{kill-comment }).

@item M-q
Fill a comment (@code{fill-paragraph}).  Wrap lines at column
@code{fill-column} and insert new comment characters, aligned with the
original comment character.

@end table

The following variables affect comments:

@vtable @code
@item maplev-auto-fill-comment-flag
A boolean flag. If non-nil, the default, comment lines wrap as they are
typed.  Wrapping, however, does not automatically start in an inline
comment; it must be invoked with @code{fill-paragraph}.

@item maplev-comment-string
String variable inserted by @code{indent-for-comment}.
The default is @samp{# }.

@item maplev-comment-column
Initial value of @code{comment-column}.  The default is 40.

@item maplev-comment-fill-column
Initial value of @code{fill-column}.  The default is 79.

@end vtable

Maple comment lines can be continued to the next line by ending them
with a backslash.  MapleV does @emph{not} recognize this continuation
and interprets the following line as code.  This can fool the MapleV
indentation grammar; however, it can also be used to achieve certain
effects.  @xref{Preventing indentation}, for an example.

@c {{{endfold}}}
@c {{{ Shortcuts }}}

@node Shortcuts, Imenu support, Comments, top
@chapter Shortcuts
@cindex Shortcuts

@menu
* Abbreviations::               Abbreviations for common Maple functions.
* Templates::                   Inserting procedures and assignments.
@end menu

@c {{{   abbreviations }}}

@node Abbreviations, Templates, Shortcuts, Shortcuts
@section Abbreviations
@cindex Abbreviations
@cindex Custom abbreviations

Abbreviations are available for common or lengthy Maple keywords. They
are expanded whenever @code{abbrev-mode} is active.
@inforef{Abbrevs,,emacs}. The command @code{maplev-abbrev-help} displays
a list of the available abbreviations.

The following variables affect the expansion of abbreviations:

@table @code
@item maplev-initial-abbrev-mode-flag
If non-nil @code{abbrev-mode} is activated when MapleV is started.  The
default is @samp{t}.

@item maplev-expand-abbrevs-in-comments-and-strings-flag
If non-nil then the Maple abbreviations are expanded in comments and
strings. The default is @samp{nil}.

@end table

@menu
* Customizing Abbreviations::   
@end menu


@c {{{   customizing }}}


@node Customizing Abbreviations,  , Abbreviations, Abbreviations
@subsection Customizing Abbreviations

The predefined MapleV abbreviations are stored in the abbreviation table
@code{maplev-mode-abbrev-table}.  The following code may be added to
your @file{.emacs} file to assign @samp{simp} as an abbreviation for
@samp{simplify}.

@example
(define-abbrev maplev-mode-abbrev-table 
        "simp" "simplify" 'maplev--abbrev-hook)
@end example

The function @samp{'maplev--abbrev-hook} prevents the abbreviation from
being expanded inside a comment or quote.

To remove an abbreviation from the table assign it @code{nil}.  For
example, to prevent @samp{lib} from expanding to @samp{libname}, add the
following to @file{emacs}:

@example
(define-abbrev maplev-mode-abbrev-table "lib" nil nil)
@end example


@c {{{endfold}}}

@c {{{endfold}}}
@c {{{   templates }}}

@node Templates,  , Abbreviations, Shortcuts
@section Templates
@cindex Templates
@cindex Procedure template
@cindex Template, procedure
@cindex Assignment operator, template

@kindex C-c C-p
@kindex C-;

@findex maplev-proc-template
@findex maplev-insert-assignment-operator

@table @kbd
@item C-c C-p
Insert a procedure template (@code{maplev-proc-template}).  The user is
queried for the name, arguments, and a description of the procedure.
Any of the entries can be left blank.  If the name is blank then an
anonymous procedure is inserted, otherwise an assignment is inserted
with the procedure assigned to the given name.  Backquotes are added
automatically to procedure names if required by Maple.

@item C-;
Insert an assignment operator at the end of the current line
(@code{maplev-insert-assignment-operator}).

@end table


The following variables affect the shortcuts:

@vtable @code
@item maplev-insert-copyright-flag
If non-nil then a copyright notice is inserted in the @code{option}
declaration of the procedure template.  The default is @code{t}.

@item maplev-copyright-owner
String inserted as the copyright owner.

@item maplev-comment-end-flag
If non-nil then the name of the procedure is inserted as a comment to
the right of the closing @code{end} statement.

@item maplev-assignment-operator
The string inserted by @code{maplev-insert-assignment-operator}.
The default value is @samp{ := }.

@end vtable

@c {{{endfold}}}

@c {{{endfold}}}
@c {{{ Imenu support }}}

@node Imenu support, Mint, Shortcuts, top
@chapter Imenu support
@cindex Imenu
@cindex Index, procedures
@cindex Procedure index

@findex maplev-add-imenu

Executing @kbd{maplev-add-imenu} or selecting @kbd{MapleV -> Add Index}
from the menubar creates an indexed menu of the top-level Maple
procedures, global variables, and macro assignments.  The menu appears
under the @samp{Index} heading in the menubar.  Clicking on an item in
the menu moves point to the assignment of that item.

The assignments must be flush left to be indexed.
Only the first macro in a @code{macro} assignment is indexed.

@c {{{endfold}}}

@c {{{ Mint }}}

@node Mint, Maple, Imenu support, top
@chapter Mint
@cindex Mint
@cindex Syntax checking
@cindex Checking syntax

Mint is Maple's syntax checker. It analyzes a Maple program and produces
a report about the syntax and variable usage.  MapleV can run mint on
the entire buffer or a portion of it.  The output of mint is displayed
in a buffer with a special mode, @code{mint-mode}, that provides a
convenient means for locating and correcting syntax errors.

@menu
* Running mint::                Commands for sending code to Mint.
* Mint mode::                   Mode for viewing the output of Mint.
@end menu

@c {{{   running mint }}}

@node Running mint, Mint mode, Mint, Mint
@section Running mint
@cindex Running mint
@cindex Mint, running

@kindex C-c @key{RET} b
@kindex C-c @key{RET} p
@kindex C-c @key{RET} r
@kindex C-c @key{RET} @key{RET}

@findex mint-buffer
@findex mint-procedure
@findex mint-region
@findex mint-rerun

The following commands send source code in the buffer to Mint:

@table @kbd
@item C-c @key{RET} b
Run Mint on the buffer (@code{mint-buffer}).

@item C-c @key{RET} p
Run Mint on the current procedure (@code{mint-procedure}).

@item C-c @key{RET} r
Run Mint on the marked region (@code{mint-region}).

@item C-c @key{RET} @key{RET}
Rerun the previous Mint command (@code{mint-rerun}).

@end table

These commands are available through the menubar, @kbd{MapleV -> Mint}.
The following variables affect the output of Mint:

@vtable @code
@item mint-info-level
An integer from 0 to 4 that selects the amount of information displayed
by Mint.  0 displays no information, 4 displays the most.  The default
value is 3.  This value can be set through the menubar,
@kbd{Maplev -> Mint -> Mint level}.

@item mint-start-options
A string passed to Mint at startup.  The default is @samp{"-q"}, which
suppresses the display of the Maple logo.  Type @kbd{?mint} in Maple for
other options.

@item mint-coding-system
Symbol that defines the coding system used by Mint.  The default value
is @code{undecided-dos}.

@end vtable

@c {{{endfold}}}
@c {{{   Mint mode }}}

@node Mint mode,  , Running mint, Mint
@section Mint mode
@cindex Mint mode
@cindex Mode, Mint

Mint mode is applied to mint's output buffer.  Warnings and errors are
font locked and activated.  Moving the mouse pointer over active text
highlights it; clicking it (@kbd{mouse-2}) either moves the cursor to
the appropriate point in the source code or queries to automatically
correct an error.

The following commands are available:

@table @kbd
@item s
Incremental forward search (@code{isearch-forward}).

@item r
Incremental backward search (@code{isearch-backward}).

@item @key{RET}
Re-execute the previous mint command (@code{mint-rerun}).

@item @key{DEL}
Scroll down (@code{scroll-down}).

@item @key{SPC}
Scroll up (@code{scroll-up}).

@item mouse-2
Goto location in source, or fix error, depending on the active text.

@end table

The following variables set the display faces for the highlighted text in the
Mint buffer:

@vtable @code
@item mint-proc-face
Face for procedure names.

@item mint-warning-face
Face for warnings.

@item mint-error-face
Face for errors.

@item mint-note-face
Face for notes (usually @samp{on line}).

@end vtable

@c {{{endfold}}}

@c {{{endfold}}}
@c {{{ Cmaple }}}

@node Maple, Help pages, Mint, top
@chapter Maple
@cindex Cmaple
@cindex Maple, command line

The command line version of Maple can be started in a buffer.  All or
portions of the code in the MapleV buffer can be passed directly to the
Maple process.  Maple commands can be directly executed in the buffer.

@menu
* Running Maple::               Commands for sending code to the Maple engine.
* Cmaple mode::                 Mode for interacting with Maple.
@end menu

@c {{{   running maple }}}

@node Running Maple, Cmaple mode, Maple, Maple
@section Running Maple
@cindex Cmaple, running
@cindex Running, Cmaple

@kindex C-c C-c b
@kindex C-c C-c p
@kindex C-c C-c r
@kindex C-c C-c g
@kindex C-c C-c i
@kindex C-c C-c k

@findex cmaplev-send-buffer
@findex cmaplev-send-procedure
@findex cmaplev-send-region
@findex cmaplev-goto-buffer
@findex cmaplev-interrupt
@findex cmaplev-kill

The following commands in the MapleV buffer affect the Maple engine:

@table @kbd
@itemx C-c C-c b
Send the entire buffer to the Maple engine (@code{cmaplev-send-buffer}).

@item C-c C-c p
Send the current procedure to the Maple engine
(@code{cmaplev-send-procedure}).

@item C-c C-c r
Send the marked region to the Maple engine (@code{cmaplev-send-region}).

@item C-c C-c g
Goto the Maple buffer (@code{cmaplev-goto-buffer}).

@item C-c C-c i
Interrupt the Maple engine (@code{cmaplev-interrupt}).

@item C-c C-c k
Kill the Maple engine (@code{cmaplev-kill}).

@end table

These commands are available through the menubar, @kbd{MapleV -> Maple}.

@c {{{endfold}}}
@c {{{   cmaple mode }}}

@node Cmaple mode,  , Running Maple, Maple
@section Cmaple mode
@cindex Cmaple mode
@cindex Mode, cmaple

The command line version of Maple is run in a buffer with the mode
@code{cmaple-process-mode} that is based on @code{comint-mode}.
In addition to the normal @code{comint} commands, the following commands
are available:

@table @kbd
@item ?
@itemx C-?
Display a Maple help topic (@pxref{Help pages}).

@item M-?
Display a Maple procedure (@pxref{Procedures}).

@end table

@c {{{endfold}}}

@c {{{endfold}}}
@c {{{ Help }}}

@node Help pages, Procedures, Maple, top
@chapter Help pages
@cindex Help pages, Maple
@cindex Maple help pages

Help pages can be read from the Maple help databases and displayed in a
buffer with major mode @code{maplev-help-mode}.  Text in the buffer is
highlighted and cross references are activated.

@menu
* Displaying help pages::       Commands for displaying Maple help pages.
* MapleV help mode::            Mode for viewing Maple help pages.
@end menu

@c {{{   displaying help pages }}}

@node Displaying help pages, MapleV help mode, Help pages, Help pages
@section Displaying help pages

@kindex C-?
@kindex S-mouse-2

@findex maplev-help-at-point
@findex maplev-help-follow-mouse

The following commands display Maple help pages:

@table @kbd
@item C-?
Query for a help topic, using the word at point as a default.  Display
the help page in a buffer (@code{maplev-help-at-point}).

@item S-mouse-2
Display the Maple help page for the topic at the click
(@code{maplev-help-follow-mouse}).

@end table

Help pages are displayed in a buffer with major mode
@code{maplev-help-mode}.
@ifinfo 
@xref{MapleV help mode}.
@end ifinfo

@c {{{endfold}}}
@c {{{   help mode }}}

@node MapleV help mode,  , Displaying help pages, Help pages
@section MapleV help mode
@cindex MapleV help mode
@cindex Mode, help, MapleV
@cindex History, help mode

@findex maplev-help-mode
@findex maplev-clear-history

The major mode @code{maplev-help-mode} is active in the buffer that
displays Maple help pages.  Section headers are font locked and text in
the @samp{See Also} section is activated so that clicking on it opens
the help page for the topic.  The following commands are available:

@kindex s
@kindex p
@kindex n
@kindex P
@kindex r
@kindex ?

@table @kbd
@item s
Incremental forward search (@code{isearch-forward}).

@item p
Previous help topic (@code{maplev-prev-item}).

@item n
Next help topic (@code{maplev-next-item}).

@item P
Parent help topic (@code{maplev-help-parent}).

@item r
Redraw help page (@code{maple-redo-item}).

@item ?
@itemx C-?
@itemx @key{RTN}
Query for a help topic (@code{maplev-help-at-point}).

@item M-?
Query for a procedure (@code{maplev-proc-at-point}).

@item @key{SPC}
Scroll down.

@item @key{DEL}
Scroll up.

@end table

MapleV help mode keeps a history of the help topics displayed.
Use the command @code{maplev-clear-history} to erase the history.

The help page for a chosen topic is displayed by sending the string
@samp{?TOPIC} to the Maple engine and capturing the output.  If the
Maple engine is busy an error message, @samp{Maple busy}, is displayed in
the message window.  

@c {{{endfold}}}

@c {{{endfold}}}
@c {{{ Proc }}}

@node Procedures, Installation, Help pages, top
@chapter Procedures
@cindex Procedures, Maple
@cindex Maple, procedures
@cindex Displaying Maple procedures

Procedures can be read from the active Maple libraries and displayed in
a buffer with major mode @code{maplev-proc-mode}. The code is font
locked the same as in MapleV mode.

@menu
* Displaying procedures::       Commands to display Maple procedures.
* MapleV proc mode::            Mode for viewing Maple procedures.
@end menu

@c {{{   displaying procedures }}}

@node Displaying procedures, MapleV proc mode, Procedures, Procedures
@section Displaying procedures
@kindex M-?
@kindex M-S-mouse-2

@findex maplev-proc-at-point
@findex maplev-proc-follow-point

The following commands display Maple procedures:

@table @kbd
@item M-?
Query for a procedure name, using the word at point as the default.
Read the procedure from the Maple library and display it in a buffer
(@code{maplev-proc-at-point}).

@item M-S-mouse-2
Read the procedure at the click from the library and display it in a
buffer (@code{maplev-proc-follow-point}).

@end table

Procedures are displayed in a buffer with major mode
@code{maplev-proc-mode}.
@ifinfo
@xref{MapleV proc mode}.
@end ifinfo

@c {{{endfold}}}
@c {{{   proc mode }}}

@node MapleV proc mode,  , Displaying procedures, Procedures
@section MapleV proc mode
@cindex MapleV proc mode
@cindex Mode, proc, MapleV
@cindex History, proc mode

@findex maplev-proc-mode
The major mode @code{maplev-proc-mode} is active in the buffer that
displays Maple procedures read from a Maple library.  It font locks the
procedure, highlighting keywords the same as MapleV mode does.  Clicking
on procedure names in the buffer displays their source code or opens a
help page for them.  A history mechanism stores the previously displayed
procedure.

The following commands are available:

@table @kbd
@item s
Incremental forward search (@code{isearch-forward}).

@item p
Previous procedure (@code{maplev-prev-item}).

@item n
Next procedure (@code{maplev-next-item}).

@item r
Redraw procedure (@code{maple-redo-item}).

@item ?
@itemx C-?
@itemx @key{RTN}
Query for a help topic (@code{maplev-help-at-point}).

@item M-?
Query for a procedure (@code{maplev-proc-at-point}).

@item @key{SPC}
Scroll down.

@item @key{DEL}
Scroll up.

@end table

MapleV help mode keeps a history of the help topics displayed.
Use the command @code{maplev-clear-history} to erase the history.

A procedure is read from a library and displayed by using the Maple
procedure @samp{maplev_print} that is assigned when the Maple engine is
started.  If the Maple engine is busy an error message, @samp{Maple
busy}, is displayed in the message window.

@c {{{endfold}}}

@c {{{endfold}}}

@c Appendices

@c {{{ Installation }}}

@node Installation, Evolution, Procedures, top
@appendix Installation

@cindex Installation
@cindex @file{.emacs}
@cindex Initialization
@cindex Customization

This section describes how to install MapleV into GNU Emacs.

@menu
* Compiling::                   Byte compiling MapleV.
* Customizing::                 Customizing the installation.
* Info documentation::          Installing the Info documentation.
@end menu


@c {{{   compiling }}}

@node Compiling, Customizing, Installation, Installation
@section Compiling

Move the file @file{maplev.el} into your Emacs load path and byte
compile it as shown below:

@example
@kbd{M-x byte-compile-file} @key{RET} maplev.el @key{RET}
@end example

Add the following line to your @file{.emacs} file:

@example
(autoload 'maplev-mode "maplev" "Maple editing mode" t)
@end example

To have Emacs auto-magically start in MapleV mode when editing Maple
source, add the following to your @file{.emacs} file, modifying the
regex @file{.mpl} to an extension appropriate for your usage:

@example
(setq auto-mode-alist 
      (cons `("\\.mpl\\'" . maplev-mode) auto-mode-alist))
@end example

@c {{{endfold}}}
@c {{{   customizing }}}

@node Customizing, Info documentation, Compiling, Installation
@section Customizing

You must customize some of MapleV's default settings to be appropriate
for your installation.  Most significantly, you must specify the
locations of the executable files for mint and the command line version
of Maple.  You can specify multiple versions of mint and Maple.  The
easiest method is to invoke @code{customize} using the following
commands:

@example
M-x load-library @key{RET} maplev @key{RET}
M-x customize-group @key{RET} maplev @key{RET}
@end example

The important options are in the subgroup @code{maplev-important}.
After setting these options, save them to your @file{.emacs} file by
clicking on the @samp{Save for Future Sessions} button.

@c {{{endfold}}}
@c {{{   installing info docs }}}

@node Info documentation,  , Customizing, Installation
@section Info documentation

To create the Info documentation for MapleV, convert the TeXinfo
file @file{maplev.texi} to an Info file.  You may use either the
stand-alone utility @code{makeinfo} or, from inside Emacs, the command
@code{makeinfo-buffer}.

Move the output file @file{maplev} to a directory in the Info
load path and then edit the @file{dir} file, that is,
the top level node of your Emacs Info structure, to point to 
@file{maplev}.  I added the following menu item to my @file{dir} file:

@example
* MapleV: (maplev).       MapleV reference manual.
@end example


@c {{{endfold}}}

@c {{{endfold}}}
@c {{{ Evolution }}}

@node Evolution, Key Index, Installation, top
@appendix Evolution

@c {{{ Bugs }}}

@menu
* Bugs::                        
* Acknowledgments::             
* Enhancements::                
@end menu

@node Bugs, Acknowledgments, Evolution, Evolution
@section Bugs

If you encounter a bug in this package, wish to suggest an enhancement,
or want to make a smart remark, then send an email to me, the humble
developer.

   Joseph S. Riel (Joe Riel) @samp{joer@@k-online.com}

@c {{{endfold}}}
@c {{{ Acknowledgements }}}

@node Acknowledgments, Enhancements, Bugs, Evolution
@section Acknowledgements
@cindex Acknowledgements
@cindex Credits
@cindex Gap mode

I'd like to thank a number of people who have contributed, either
directly or indirectly, to this package.


@table @b
@item Bruno Salvy
For writing @code{maple-mode}, a small but useful Emacs
mode for editing Maple code.

@item Michael Smith
For writing @code{Gap-mode} and @code{Gap-process}.
These gave me the idea, and showed me how, to display help pages.
Displaying source code from the Maple libraries was a natural extension.
@code{Gap} is a CAS specialized for group theory.

@item Nicholas Thi@'ery
For writing @code{Maple-mode}, another Emacs mode for
editing Maple code.  It introduced the idea of using a grammar to indent
Maple source code.

@item Bob Glickstein
For writing @cite{Writing GNU Emacs Extensions}.
It allowed me, a novice Elisp programmer, to put it all together.

@item Christian Pomar
For courageously agreeing to test a series of alpha
versions of this package.  He found numerous errors and suggested many
improvements.

@end table

@c {{{endfold}}}
@c {{{ Enhancements }}}

@node Enhancements,  , Acknowledgments, Evolution
@section Enhancements
@cindex Enhancements
@cindex Debugger, source code
@cindex Code debugger
@cindex LaTeX 
@cindex MapleDoc

The following is a short list of features that I am tentatively planning
to add to MapleV.

@itemize @bullet
@item
Source code debugger.  The Maple debugger @code{DEBUG} provides a useful
means to step through code; its interface, however, leaves much to be
desired.  A more convenient interface would be similar to that of
@code{Edebug}, the Emacs-Lisp source code debugger.

@item
La@TeX{} support.  I use MapleDoc, a La@TeX{} macro package that I wrote,
for documenting Maple source code.  To facilitate its use MapleV should
be able to font-lock La@TeX{} keywords in comments.  This will be an
optional package.

@end itemize

@c {{{endfold}}}

@c {{{endfold}}}

@c {{{ Indices and Endmatter }}}

@node Key Index, Function Index, Evolution, top
@comment    node-name,         next,       previous, up
@unnumbered Key Index

@printindex ky

@node Function Index, Variable Index, Key Index, top
@comment    node-name,         next,       previous, up
@unnumbered Function Index

@printindex fn

@node Variable Index, Concept Index, Function Index, top
@comment    node-name,         next,       previous, up
@unnumbered Variable Index

@printindex vr

@node Concept Index,  , Variable Index, top
@comment      node-name, next,       previous, up
@unnumbered Concept Index

@printindex cp

@summarycontents
@contents
@bye

@c {{{endfold}}}
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/edit-env.el0000775000000000000000000001323212230377266021305 0ustar  ;;; edit-env.el --- display and edit environment variables

;; Copyright (C) 2001 Benjamin Rutt
;;
;; Maintainer: Benjamin Rutt 
;; Version: 1.0

;; This file is not part of GNU Emacs.

;; This file 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 2, 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 GNU Emacs; see the file COPYING.  If not, send e-mail to
;; this program's maintainer or write to the Free Software Foundation,
;; Inc., 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This file uses the widget library to display, edit, delete and add
;; environment variables.  Inspired by "G c" in a gnus *Group* buffer.
;; Bug reports or patches are welcome, please use the above email
;; address.

;;; Usage:

;; put this file in your load-path and add the line
;;
;; (require 'edit-env)
;;
;; to your ~/.emacs file.
;;
;; Then, type
;;
;; M-x edit-env
;;
;; to enter the environment editor.  To change variables, simply edit
;; their values in place.  To delete variables, delete their values.
;; To add variables, add a new rows to the list at the bottom by
;; pressing [INS]; then, add a new name/value pair of the form
;; VAR=VALUE (e.g. FOO=BAR).  After changing and/or deleting and/or
;; adding environment variables, press the [done] button at the top.
;; Note that environment variable changes will only be visible to your
;; current emacs session or child processes thereof.

;;; Code:

;; XEmacs compatibility stuff
(if (string-match "XEmacs" (emacs-version))
    (require 'overlay))

(require 'widget)

(require 'wid-edit)
(eval-when-compile (require 'cl))

(defvar edit-env-ls nil)
(defvar edit-env-changed-ls nil)
(defvar edit-env-added-ls nil)

(defun edit-env-update ()
  (let ((var nil)
	(value nil)
	(vars-changed nil))
    (when edit-env-changed-ls
      (mapcar
       (lambda (x)
	 (setq var (car x))
	 (setq value (widget-value (cadr x)))
	 (if (equal value "")
	     (setenv var nil) ;; i.e. unset var
	   (setenv var value))
	 (add-to-list 'vars-changed var))
       edit-env-changed-ls)
      (setq edit-env-changed-ls nil))
    
    (when edit-env-added-ls
      (mapcar
       (lambda (x)
	 (if (and x (not (string-match "^[ \t\n]*$" x)))
	     (progn
	       (let ((splits (split-string x "=")))
		 (if (not (= (length splits) 2))
		     (message "invalid format %s" x)
		   (setq var (car splits))
		   (setq value (cadr splits))
		   (if value (add-to-list 'vars-changed var))
		   (setenv var value))))))
       (widget-value edit-env-added-ls))
      (setq edit-env-added-ls nil))
    (when vars-changed
      ;; Need to regenerate the buffer before burial.  An alternative
      ;; to re-generation followed by burial would be simply to
      ;; kill-buffer.
      (edit-env)
      (message
       (format "Updated environment variable%s %s"
	       (if (> (length vars-changed) 1) "s" "")
	       (mapconcat 'identity vars-changed ", "))))
    (bury-buffer)))
  
(defun edit-env-mark-changed (widget)
  (add-to-list 'edit-env-changed-ls
	       (list (widget-get widget 'environment-variable-name)
		     widget)))
  
(defun edit-env ()
  "Display, edit, delete and add environment variables."
  (interactive)
  (setq edit-env-ls nil
	edit-env-changed-ls nil
	edit-env-added-ls nil)
  (switch-to-buffer "*Environment Variable Editor*")
  (kill-all-local-variables)
  (let ((inhibit-read-only t))
    (erase-buffer))
  (let ((all (overlay-lists)))
    ;; Delete all the overlays.
    (mapcar 'delete-overlay (car all))
    (mapcar 'delete-overlay (cdr all)))
  (widget-insert "Edit environment variables below, and press ")
  (let ((pair nil)
	(var nil)
	(val nil)
	(longest-var 0)
	(current-widget nil))
    (setq edit-env-ls (copy-list process-environment))
    (setq edit-env-ls (sort edit-env-ls (lambda (a b) (string-lessp a b))))

    (widget-create 'push-button
		   :notify (lambda (widget &rest ignore)
			     (edit-env-update))
		   :help-echo "press to update environment variables"
		   "done")
    (widget-insert ".\n")

    (mapcar
     (lambda (x)
       (let* ((pair (split-string x "="))
	      (var (car pair))
	      (val (cadr pair)))
	 (setq longest-var (max longest-var (length var)))))
     edit-env-ls)
    (mapcar
     (lambda (x)
       (let* ((pair (split-string x "="))
	      (var (car pair))
	      (val (or (cadr pair) "")))
	 (widget-insert "\n")
	 (widget-insert (format (format "%%%ds" (1+ longest-var)) var))
	 (widget-insert " ")
	 (setq current-widget
	       (widget-create 'editable-field
			      :size (1- (length val))
			      :notify (lambda (widget &rest ignore)
					(edit-env-mark-changed widget))
			      :format "%v" val))
	 (widget-put current-widget 'environment-variable-name var)))
       edit-env-ls)
    (widget-insert "\n\nTo add environment variables, ")
    (widget-insert "add rows of the form VAR=VALUE\n")
    (widget-insert "to the following list:\n")
    (setq edit-env-added-ls
	  (widget-create
	   'editable-list
	   :entry-format "%i %d %v"
	   :value nil
	   '(editable-field :value "")))
    (use-local-map widget-keymap)
    (widget-setup)
    (setq truncate-lines t)
    ;; in future GNU emacs >= 21, auto-show-mode may be removed.
    (when (fboundp 'auto-show-mode)
      (auto-show-mode 1))
    (goto-char (point-min))))

(provide 'edit-env)

;;; edit-env.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/joc-toggle-buffer.el0000775000000000000000000002255112230377266023077 0ustar  ;;; @(#) toggle-buffer.el --- flips back and forth between two buffers

;; Copyright (C) 2001 by Joseph L. Casadonte Jr.

;; Author:          Joe Casadonte (emacs@northbound-train.com)
;; Maintainer:      Joe Casadonte (emacs@northbound-train.com)
;; Created:         January 26, 2001
;; Keywords:        toggle buffer
;; Latest Version:  http://www.northbound-train.com/emacs.html

;; This file is not part of Emacs

;; COPYRIGHT NOTICE

;; 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 2, 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;;
;;  This package provides a way to toggle back and forth between the
;;  last two active buffers, without any extra keystrokes (like
;;  accepting the default argument to `switch-to-buffer').

;;; Nut & Bolts:
;;
;;  This package works by advising `switch-to-buffer', so if your
;;  favorite buffer switching command does not ultimately call
;;  `switch-to-buffer', this won't work.  Packages that alter the
;;  current buffer *before* `switch-to-buffer' is called will also not
;;  work properly.  Both of these situations may be salvagable with
;;  the addition of more advice.  In the first case, just write a bit
;;  of advice which essentially duplicates what I'm doing here with
;;  `switch-to-buffer'.
;;
;;  I've provided a hack (and a "hook") to help with the second
;;  situation.  The hack is to define a second variable (the "hook")
;;  before the list is altered.  Once `switch-to-buffer' is called,
;;  the advice provided in this package will first look for this
;;  hook/hack variable and use its value; if that's not found, it will
;;  use the value returned by `buffer-name'.
;;
;;  An example of this is the `swbuff' package, which changes the
;;  current buffer before switching to the next one (though I'm not
;;  sure why it does this).  Since I use swbuff, I've included its
;;  hack along with this package.  You can customize whether or not
;;  this hack is loaded (see Customization below).

;;; Installation:
;;
;;  Put this file on your Emacs-Lisp load path and add the following to your
;;  ~/.emacs startup file
;;
;;     (require 'toggle-buffer)

;;; Usage:
;;
;;  M-x `joc-toggle-buffer'
;;     Switched to the previous active buffer (when `switch-to-buffer' was
;;     called).  If there is no previous buffer, or if the buffer no longer
;;     exists, a message will be displayed in the minibuffer.

;;; Customization:
;;
;;  M-x `joc-toggle-buffer-customize' to customize all package options.
;;
;;  The following variables can be customized:
;;
;;  o `joc-toggle-buffer-swbuff-advice'
;;     A hack to be compatable with the swbuff package.
;;
;;     Valid values are:
;;       o Never Advise - never advise the swbuff functions [nil]
;;       o Advise if Provided - only advise if swbuff already provided [P]
;;       o Always Advise - always define & activate the swbuff advise [A]
;;
;;     If you don't use the swbuff package, you can safely choose
;;     Never Advise or Advise if Provided.  If you do use swbuff, you
;;     may use Advise if Provided (in which case swbuff must be
;;     `provide'd already) or Always Advise."

;;; To Do:
;;
;;  o Nothing, at the moment.

;;; Comments:
;;
;;  Any comments, suggestions, bug reports or upgrade requests are welcome.
;;  Please send them to Joe Casadonte (emacs@northbound-train.com).
;;
;;  This version of toggle-buffer was developed and tested with NTEmacs 20.5.1
;;  and 2.7 under Windows NT 4.0 SP6 and Emacs 20.7.1 under Linux (RH7).
;;  Please, let me know if it works with other OS and versions of Emacs.

;;; Change Log:
;;
;;  see http://www.northbound-train.com/emacs/toggle-buffer.log

;;; **************************************************************************
;;; **************************************************************************
;;; **************************************************************************
;;; **************************************************************************
;;; **************************************************************************
;;; Code:

(eval-when-compile
  (defvar byte-compile-dynamic nil) ; silence the old byte-compiler
  (set (make-local-variable 'byte-compile-dynamic) t))

;;; **************************************************************************
;;; ***** customization routines
;;; **************************************************************************
(defgroup joc-toggle-buffer nil
  "toggle-buffer package customization"
  :group 'tools)

;; ---------------------------------------------------------------------------
(defun joc-toggle-buffer-customize ()
  "Customization of the group `joc-toggle-buffer'."
  (interactive)
  (customize-group "joc-toggle-buffer"))

;; ---------------------------------------------------------------------------
(defcustom joc-toggle-buffer-swbuff-advice "P"
  "A hack to be compatable with the swbuff package.

Valid values are:
  o Never Advise - never advise the swbuff functions [nil]
  o Advise if Provided - only advise if swbuff already provided [P]
  o Always Advise - always define & activate the swbuff advise [A]

If you don't use the swbuff package, you can safely choose
Never Advise or Advise if Provided.  If you do use swbuff, you
may use Advise if Provided (in which case swbuff must be
`provide'd already) or Always Advise."
  :type `(choice
	  (const :tag "Never Advise" nil)
	  (const :tag "Advise if Provided" "P")
	  (const :tag "Always Advise" "A"))
  :group 'joc-toggle-buffer)

;; ---------------------------------------------------------------------------
(defcustom toggle-buffer-load-hook nil
  "Hook to run when package is loaded."
  :type 'hook
  :group 'joc-toggle-buffer)

;;; **************************************************************************
;;; ***** version related routines
;;; **************************************************************************
(defconst joc-toggle-buffer-version
  "$Revision: 1.2 $"
  "Version number for toggle-buffer package.")

;; ---------------------------------------------------------------------------
(defun joc-toggle-buffer-version-number ()
  "Return `toggle-buffer' version number."
  (string-match "[0123456789.]+" joc-toggle-buffer-version)
  (match-string 0 joc-toggle-buffer-version))

;; ---------------------------------------------------------------------------
(defun joc-toggle-buffer-display-version ()
  "Display `toggle-buffer' version."
  (interactive)
  (message "toggle-buffer version <%s>." (joc-toggle-buffer-version-number)))

;;; **************************************************************************
;;; ***** interactive functions
;;; **************************************************************************
(defvar joc-toggle-buffer-last-buffer nil
  "Contains the name of the previous buffer.")

(defun joc-toggle-buffer ()
  "Switch to previous active buffer."
  (interactive)
  (if (not (boundp 'joc-toggle-buffer-last-buffer))
	  (error "No previous buffer to switch to (yet)"))
  (let ((buff (get-buffer joc-toggle-buffer-last-buffer)))
	(if (not buff)
		(error "Invalid buffer \"%s\"" joc-toggle-buffer-last-buffer)
	  (switch-to-buffer buff))))

;;; **************************************************************************
;;; ***** normal advice
;;; **************************************************************************
(defadvice switch-to-buffer
  (before joc-toggle-buffer-setup-advice act)
  "Records active buffer (for possible later recall) before it's switched."
  (if (boundp 'joc-toggle-buffer-hack)
	  (setq joc-toggle-buffer-last-buffer joc-toggle-buffer-hack)
	(setq joc-toggle-buffer-last-buffer (buffer-name))))

;;; **************************************************************************
;;; ***** swbuff-specific advice
;;; **************************************************************************
(let ((advise-swbuff-fns nil))
  (if joc-toggle-buffer-swbuff-advice
	  (if (eq joc-toggle-buffer-swbuff-advice "P")
		  (if (featurep 'swbuff)
			  (setq advise-swbuff-fns t))
		(setq advise-swbuff-fns t)))

  (if advise-swbuff-fns
	  (progn
		(defadvice swbuff-switch-to-next-buffer
		  (around joc-toggle-buffer-swbuf-next-advice act)
		  "hack for swbuff-users"
		  (setq joc-toggle-buffer-hack (buffer-name))
		  ad-do-it
		  (makunbound 'joc-toggle-buffer-hack))

		(defadvice swbuff-switch-to-previous-buffer
		  (around joc-toggle-buffer-swbuf-prev-advice act)
		  "hack for swbuff-users"
		  (setq joc-toggle-buffer-hack (buffer-name))
		  ad-do-it
		  (makunbound 'joc-toggle-buffer-hack))
		)))

;;; **************************************************************************
;;; ***** we're done
;;; **************************************************************************
(provide 'toggle-buffer)
(run-hooks 'toggle-buffer-load-hook)

;;; toggle-buffer.el ends here
;;; **************************************************************************
;;;; *****  EOF  *****  EOF  *****  EOF  *****  EOF  *****  EOF  *************
emacs-goodies-el-35.8ubuntu2/elisp/emacs-goodies-el/tabbar.el0000775000000000000000000021447012230377265021033 0ustar  ;;; Tabbar.el --- Display a tab bar in the header line

;; Copyright (C) 2003, 2004, 2005 David Ponce

;; Author: David Ponce 
;; Maintainer: David Ponce 
;; Created: 25 February 2003
;; Keywords: convenience
;; Revision: $Id: tabbar.el,v 1.2 2007-08-08 22:24:29 psg Exp $

(defconst tabbar-version "2.0")

;; This file is not part of GNU Emacs.

;; 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 2, 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.

;;; Commentary:
;;
;; This library provides the Tabbar global minor mode to display a tab
;; bar in the header line of Emacs 21 and later versions.  You can use
;; the mouse to click on a tab and select it.  Also, three buttons are
;; displayed on the left side of the tab bar in this order: the
;; "home", "scroll left", and "scroll right" buttons.  The "home"
;; button is a general purpose button used to change something on the
;; tab bar.  The scroll left and scroll right buttons are used to
;; scroll tabs horizontally.  Tabs can be divided up into groups to
;; maintain several sets of tabs at the same time (see also the
;; chapter "Core" below for more details on tab grouping).  Only one
;; group is displayed on the tab bar, and the "home" button, for
;; example, can be used to navigate through the different groups, to
;; show different tab bars.
;;
;; In a graphic environment, using the mouse is probably the preferred
;; way to work with the tab bar.  However, you can also use the tab
;; bar when Emacs is running on a terminal, so it is possible to use
;; commands to press special buttons, or to navigate cyclically
;; through tabs.
;;
;; These commands, and default keyboard shortcuts, are provided:
;;
;; `tabbar-mode'
;;     Toggle the Tabbar global minor mode.  When enabled a tab bar is
;;     displayed in the header line.
;;
;; `tabbar-local-mode'         (C-c )
;;     Toggle the Tabbar-Local minor mode.  Provided the global minor
;;     mode is turned on, the tab bar becomes local in the current
;;     buffer when the local minor mode is enabled.  This permits to
;;     see the tab bar in a buffer where the header line is already
;;     used by another mode (like `Info-mode' for example).
;;
;; `tabbar-mwheel-mode'
;;     Toggle the Tabbar-Mwheel global minor mode.  When enabled you
;;     can use the mouse wheel to navigate through tabs of groups.
;;
;; `tabbar-press-home'         (C-c )
;; `tabbar-press-scroll-left'  (C-c )
;; `tabbar-press-scroll-right' (C-c )
;;     Simulate a mouse-1 click on respectively the "home", "scroll
;;     left", and "scroll right" buttons.  A numeric prefix argument
;;     value of 2, or 3, respectively simulates a mouse-2, or mouse-3
;;     click.
;;
;; `tabbar-backward'           (C-c )
;; `tabbar-forward'            (C-c )
;;     Are the basic commands to navigate cyclically through tabs or
;;     groups of tabs.  The cycle is controlled by the
;;     `tabbar-cycle-scope' option.  The default is to navigate
;;     through all tabs across all existing groups of tabs.  You can
;;     change the default behavior to navigate only through the tabs
;;     visible on the tab bar, or through groups of tabs only.  Or use
;;     the more specialized commands below.
;;
;; `tabbar-backward-tab'
;; `tabbar-forward-tab'
;;     Navigate through the tabs visible on the tab bar.
;;
;; `tabbar-backward-group'     (C-c )
;; `tabbar-forward-group'      (C-c )
;;     Navigate through existing groups of tabs.
;;
;;
;; Core
;; ----
;;
;; The content of the tab bar is represented by an internal data
;; structure: a tab set.  A tab set is a collection (group) of tabs,
;; identified by an unique name.  In a tab set, at any time, one and
;; only one tab is designated as selected within the tab set.
;;
;; A tab is a simple data structure giving the value of the tab, and a
;; reference to its tab set container.  A tab value can be any Lisp
;; object.  Each tab object is guaranteed to be unique.
;;
;; A tab set is displayed on the tab bar through a "view" defined by
;; the index of the leftmost tab shown.  Thus, it is possible to
;; scroll the tab bar horizontally by changing the start index of the
;; tab set view.
;;
;; The visual representation of a tab bar is a list of valid
;; `header-line-format' template elements, one for each special
;; button, and for each tab found into a tab set "view".  When the
;; visual representation of a tab is required, the function specified
;; in the variable `tabbar-tab-label-function' is called to obtain it.
;; The visual representation of a special button is obtained by
;; calling the function specified in `tabbar-button-label-function',
;; which is passed a button name among `home', `scroll-left', or
;; `scroll-right'.  There are also options and faces to customize the
;; appearance of buttons and tabs (see the code for more details).
;;
;; When the mouse is over a tab, the function specified in
;; `tabbar-help-on-tab-function' is called, which is passed the tab
;; and should return a help string to display.  When a tab is
;; selected, the function specified in `tabbar-select-tab-function' is
;; called, which is passed the tab and the event received.
;;
;; Similarly, to control the behavior of the special buttons, the
;; following variables are available, for respectively the `home',
;; `scroll-left' and `scroll-right' value of `
    • \\)\\|\\(\\(.+: \\(.+\\)\\)\\)"
             "\\(\\(.+\\)\\)\\|\\(\\([^#].+\\)\\)"
             nil t)
          (let ((type (match-string 2))
              ;;(URL (match-string 4))
                (bugnumber (match-string 5))
                (description (match-string 6))
                (shortdescription (match-string 6)))
            (cond
             ((string= type "-->"))                  ;Do nothing
             (type
              (setq bugs-are-open-flag (not (string-match "resolved" type)))
              (save-excursion
                (set-buffer debian-bug-tmp-buffer)
                (insert "\"-\"\n\"" type "\"\n")))
             ((null description))                    ;Do nothing
             ((string-match "^#?[0-9]+$" description)) ;Do nothing
             (t
              (if (string-match "^[^ ]+: \\(.+\\)" description)
                  (setq shortdescription (match-string 1 description)))
              (setq bug-alist (cons (list bugnumber description) bug-alist))
              (when bugs-are-open-flag
                (when (and (re-search-forward
                            "Reported by: "
                            nil t)
                           (or (looking-at ""\\(.*\\)" <")
                               (looking-at "\\(.*\\) <")
			       (looking-at "\\(.*\\)<")))
                  (setq shortdescription
                        (concat "Bug fix: \"" shortdescription
                                "\", thanks to "
                                (debian-bug-rfc2047-decode-string
                                 (match-string 1))
                                " " (if (fboundp 'replace-regexp-in-string)
                                        (replace-regexp-in-string
                                         "%s" bugnumber
                                         (if (boundp 'debian-changelog-close-bug-statement)
                                             debian-changelog-close-bug-statement
                                           "(Closes: #%s)"))
                                      (debian-bug--rris
                                       "%s" bugnumber
                                       (if (boundp 'debian-changelog-close-bug-statement)
                                           debian-changelog-close-bug-statement
                                         "(Closes: #%s)"))))))
                (setq bug-open-alist
                      (cons
                       (list bugnumber shortdescription) bug-open-alist)))
              (save-excursion
                (set-buffer debian-bug-tmp-buffer)
                (insert
                 "["
                 (format "%S" (concat "#" bugnumber " "
                                      (if (< 60 (length description))
                                          (substring description 0 60)
                                        description)))
                 " (debian-bug-menu-action \"" bugnumber "\")"
                 " :active "
                 (if bugs-are-open-flag
                     "t"
                   "(not (eq debian-bug-menu-action 'close))")
                 "]\n")))))))
      (set-buffer debian-bug-tmp-buffer) ;Make sure we're here
      (insert "))")
      (when (debian-bug-menusplit-p nil)
        (goto-char (point-min))
        ;; First split on bug severities
        (when (and (re-search-forward "^\"-" nil t)
                   (re-search-forward "^\"" nil t))
          (when (search-forward " to upstream software authors"
                                (save-excursion (progn (end-of-line)(point)))
                                t)
            (replace-match " upstream"))
          (beginning-of-line)
          (insert "(")
          (while (and (re-search-forward "^\"-" nil t)
                      (re-search-forward "^\"" nil t))
            (when (search-forward " to upstream software authors"
                                  (save-excursion (progn (end-of-line)(point)))
                                  t)
              (replace-match " upstream"))
            (beginning-of-line)
            (insert ")("))
          (goto-char (point-max))
          (insert ")")
          ;; Next check for long menus, and split those again
          (goto-char (point-min))
          (while (re-search-forward "^)?(\"" nil t)
            (forward-char -2)
            (if (debian-bug-menusplit-p t)
                (debian-bug-submenusplit)
              (end-of-line)))
          ))
      (eval-buffer debian-bug-tmp-buffer)
      (kill-buffer nil)
      )
    (setq debian-bug-alist bug-alist)
    (setq debian-bug-open-alist bug-open-alist)
    (cond
     ((equal major-mode 'debian-changelog-mode)
      (easy-menu-define
        debian-bug-bugs-menu
        debian-changelog-mode-map "Debian Bug Mode Bugs Menu"
        debian-bug-easymenu-list)
      (cond
       ((string-match "XEmacs" emacs-version)
        (easy-menu-remove debian-bug-bugs-menu)
        (easy-menu-remove debian-changelog-menu)
        (easy-menu-add debian-bug-bugs-menu)
        (easy-menu-add debian-changelog-menu))))
     (t
      (easy-menu-define
        debian-bug-bugs-menu
        debian-bug-minor-mode-map "Debian Bug Mode Bugs Menu"
        debian-bug-easymenu-list)
      (cond
       ((string-match "XEmacs" emacs-version)
        (easy-menu-remove debian-bug-bugs-menu)
        (easy-menu-remove debian-bug-menu)
        (easy-menu-add debian-bug-bugs-menu)
        (easy-menu-add debian-bug-menu)))))))

(defun debian-bug-build-bug-this-menu ()
  "Regenerate Bugs list menu for this buffer's package."
  (if (and (featurep 'debian-changelog-mode)
           (debian-changelog-suggest-package-name))
      (debian-bug-build-bug-menu (debian-changelog-suggest-package-name) t)
    (let ((package (or (and (boundp 'debian-bug-package-name)
                            debian-bug-package-name)
                       (read-string "Package name: "))))
      (debian-bug-build-bug-menu package nil))))

(defun debian-bug-bug-menu-init (minor-mode-map)
  "Initialize empty bug menu.
Call this function from the mode setup with MINOR-MODE-MAP."
  (if debian-bug-menu-preload-flag
      (debian-bug-build-bug-this-menu)
    (easy-menu-define debian-bug-bugs-menu minor-mode-map
      "Debian Bug Mode Bugs Menu"
      '("Bugs"
        ["* Generate menu *" (debian-bug-build-bug-this-menu)
         (debian-bug-check-for-program "wget")])))
  (easy-menu-add debian-bug-bugs-menu))

;;;-------------
;;; debian-bug-filename - Peter Galbraith, July 2002.
;;;

(defun debian-bug-search-file (filename)
  "Search for FILENAME returning which package name it belongs to."
  (save-excursion
    (let ((tmp-buffer (get-buffer-create " *debian-bug-tmp*"))
          (expanded-file (expand-file-name filename))
          (package))
      (set-buffer tmp-buffer)
      (unwind-protect
          (progn
            (condition-case err
                (call-process "dlocate" nil '(t nil) nil "-S" expanded-file)
              (file-error
               (message "dlocate not installed...")))
            (goto-char (point-min))
            (when (re-search-forward
                   (concat "^\\(.*\\): " (regexp-quote expanded-file) "$")
                   nil t)
              ;; found one at least.  Try for another.
              (setq package (match-string 1))
              (when (re-search-forward
                     (concat "^.*: " (regexp-quote expanded-file) "$") nil t)
                (setq package nil)))
            (if package
                package
              (message "Calling dpkg for the search...")
              (erase-buffer)
              (call-process "dpkg" nil '(t nil) nil "-S"
                            (expand-file-name filename))
              (message "Calling dpkg for the search...done")
              (goto-char (point-min))
              (cond
               ((re-search-forward "not found.$" nil t)
                (message "%s not found in package list" filename)
                nil)
               ((re-search-forward "^\\(.*, .*\\): " nil t)
                (with-output-to-temp-buffer "*Help*"
                  (princ (format "Please refine your search,\nthere is more than one matched package:\n\n%s" (match-string 1))))
                nil)
               ((re-search-forward "^\\(.*\\): " nil t)
                (match-string 1))
               (t
                (message "%s not found in package list" filename)
                nil))))
        (kill-buffer tmp-buffer)))))

(defun debian-bug-filename ()
  "Submit a Debian bug report for a given filename's package."
  (let ((filename (read-file-name "Filename: " "/" nil t nil)))
    (cond
     ((string-equal "" filename)
      (message "Giving up"))
     (t
      (let ((package (debian-bug-search-file filename)))
        (if package
            (let ((answer (y-or-n-p (format "File is in package %s; continue? "
                                            package))))
              (when answer
                (debian-bug-package package filename)))))))))

;;;###autoload
(defun debian-bug ()
  "Submit a Debian bug report."
  (interactive)
  (let ((type (let ((cursor-in-echo-area t))
                (message
                 "Report a bug for a [P]ackage or [F]ile: (default P) ")
                (capitalize (read-char-exclusive)))))
    (cond
     ((or (equal 13 type)               ; 
          (equal ?\r type)              ; 
          (equal ?\  type)              ; 
          (equal 32 type)               ; 
          (equal ?p type)
          (equal ?P type))
      (debian-bug-package))
     ((equal ?F type)
      (debian-bug-filename))
     (t
      (message "Sorry, try that again")))))

(provide 'debian-bug)

;;; debian-bug.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/debian-el/preseed.el0000775000000000000000000000312712230377265017725 0ustar  ;;; preseed.el --- a major mode for editing debian-installer preseed files

;; Copyright (C) 2004 W. Borgert 

;; This package 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 2, or (at your option)
;; any later version.

;; This package 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.

;;; Code:
(require 'font-lock)

(defvar preseed-mode-abbrev-table nil
  "Abbreviation table used in d-i preseed buffers.")
(define-abbrev-table 'preseed-mode-abbrev-table ())

(defvar preseed-font-lock-keywords
  '(("^\\([a-z-]+\\)[ \t]+\\([^ ]+\\)[ \t]+\\([^ ]+\\)"
     (1 font-lock-keyword-face)
     (2 font-lock-function-name-face)
     (3 font-lock-type-face))
    ("\\(^\\s-*#.*\\)"
     (1 font-lock-comment-face)))
  "Keyword patterns for preseed-mode fontification.")

;;;###autoload
(defun preseed-mode ()
  "Major mode for editing debian-installer preseed files colourfully."
  (interactive)
  (kill-all-local-variables)
  (setq comment-start "#"
 	comment-multi-line nil
	comment-start-skip "#+[\t ]*")
  (setq major-mode 'preseed-mode
 	mode-name "Preseed"
 	local-abbrev-table preseed-mode-abbrev-table)
  (run-hooks 'preseed-mode-hook)
  (set (make-local-variable 'font-lock-defaults)
       '(preseed-font-lock-keywords nil nil ((?_ . "w")))))

(provide 'preseed)

;;; preseed.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/debian-el/gnus-BTS.el0000775000000000000000000000763112230377265017704 0ustar  ;;; gnus-BTS.el --- access the Debian Bug Tracking System from Gnus

;; Copyright (C) 2001 Andreas Fuchs 

;; Author: Andreas Fuchs
;; Maintainer: Andreas Fuchs 
;; Keywords: gnus, Debian, Bug
;; Status: Works in XEmacs (I think >=21)
;; Created: 2001-02-07

;; $Id: gnus-BTS.el,v 1.1.1.1 2003-04-04 20:16:01 lolando Exp $

;; This file is not part of GNU Emacs.

;; gnus-BTS.el 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 2, or (at your option)
;; any later version.

;; gnus-BTS.el 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Use this program if you read a lot of debian lists and see many
;; references to the Bug Tracking system in them. It expects to see
;; Bug references in the form of (for example): "#48273", "closes:
;; 238742" or similar.

;;; Code:


(setq anti-bug-special-keywords "reassign\\|merge")
(setq anti-bug-keywords (concat
			 "tags\\|severity\\|retitle\\|close\\|closes:\\|Merged\\|reopen\\|Bug\\|"
			 anti-bug-special-keywords))

(setq anti-bug-prefix " *#?\\|Bugs?\\|#")
(setq anti-bug-number " *\\([0-9]+\\)")
(setq anti-bug-special " +\\([0-9]+\\|[-.A-Za-z0-9]+\\)")

(setq anti-gnus-debian-bug-regexp (concat
				   "\\("
				   "\\("
				   anti-bug-keywords
				   "\\)"
				   anti-bug-prefix
				   "\\)"
				   anti-bug-number))

(setq anti-gnus-debian-reassign-or-merge-regexp
      (concat
       "\\("
       anti-bug-special-keywords
       "\\)"
       anti-bug-number
       anti-bug-special))

(setq anti-gnus-debian-reassign-regexp "reassigned from package `\\([^']*\\)' to `\\([^']*\\)'")
(setq anti-gnus-debian-bug-BTS-regexp "^ *\\([0-9]+\\)")

(defun anti-browse-debpkg-or-bug (thing)
  (interactive "i")
  (require 'thingatpt)
  (let* ((the-thing (if (null thing)
			(thing-at-point 'sexp)
		      thing))
	 (bugp (string-match "[0-9]+$" the-thing))
	 (bug-or-feature (if bugp
			     (progn
			       (string-match "^[^0-9]*\\([0-9]+\\)$" the-thing)
			       (match-string 1 the-thing))
			   the-thing))
	 (url (if bugp
		  "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug="
		"http://cgi.debian.org/cgi-bin/search_packages.pl?&searchon=names&version=all&release=all&keywords=")))
    (browse-url (concat url bug-or-feature))))

(defvar in-debian-group-p nil)
(add-hook 'gnus-select-article-hook
	  (lambda ()
	    (setq in-debian-group-p (string-match "debian"
						  (gnus-group-real-name
						   gnus-newsgroup-name)))))

(defvar in-debian-devel-announce-group-p nil)
(add-hook 'gnus-select-article-hook
	  (lambda ()
	    (setq in-debian-devel-announce-group-p
		  (string-match "debian.devel.announce"
				(gnus-group-real-name
				 gnus-newsgroup-name)))))

(defun anti-buttonize-debian (regexp num predicate)
  (add-to-list 'gnus-button-alist
	       (list regexp
		     num
		     predicate
		     'anti-browse-debpkg-or-bug
		     num)))

(add-hook
 'gnus-article-mode-hook    ; only run once, as soon as the article buffer has been created.
 (lambda ()
   (anti-buttonize-debian anti-gnus-debian-bug-regexp 3
			  'in-debian-group-p)
   (anti-buttonize-debian anti-gnus-debian-reassign-or-merge-regexp 3
			  'in-debian-group-p)
   (anti-buttonize-debian anti-gnus-debian-bug-BTS-regexp 1
			  'in-debian-devel-announce-group-p)
   
   (anti-buttonize-debian anti-gnus-debian-reassign-regexp 1
			  'in-debian-group-p)
   (anti-buttonize-debian anti-gnus-debian-reassign-regexp 2
			  'in-debian-group-p)))

(provide 'gnus-BTS)
emacs-goodies-el-35.8ubuntu2/elisp/debian-el/deb-view.el0000775000000000000000000007330112230377265020001 0ustar  ;;; deb-view.el --- view Debian package files with tar-mode

;; Copyright (C) 1998 Rick Macdonald 
;; Copyright (C) 2003, 2004, 2005, 2009 Peter S Galbraith 

;; Author:     Rick Macdonald 
;; Maintainer: Peter S. Galbraith 
;; Version: 1.15

;; This file is not part of GNU Emacs.

;; deb-view 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 2, or (at your option)
;; any later version.

;; deb-view 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 deb-view; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; deb-view presents the contents of debian package archive files for
;; viewing. The viewing is done with the major mode "debview", which
;; is derived from emacs tar-mode with a few enhancements for viewing
;; compressed files, HTML files and formatted man pages.  The normal
;; editing and saving features of tar-mode are not supported by
;; deb-view.

;; deb-view includes a command called deb-find which requires that you
;; have the debian distribution directories on a local or mounted
;; filesystem. Give it a string or regular expression and it presents a
;; buffer of matching deb file names.  Click with the middle mouse button
;; or press RETURN (or ^C^C) and it launches deb-view on the selected
;; file. deb-find can be configured to use locate or find, or any other
;; external command. The find method passes your search specification to
;; egrep, whereas the locate method uses your string directly.

;; deb-view extracts the control.tar.gz and data.tar.gz files from
;; debian package and presents two buffers in a derivitive of
;; tar-mode. See tar-mode for info.

;; Required programs: ar, gzip.
;; Optionally required programs: nroff for formatting man pages.
;; Optionally required programs: dpkg-deb for old-style binary .deb files.
;; Optionally required programs: w3-mode for viewing HTML pages.

;; For new-style .deb files (2.0), dpkg-deb isn't used. Therefore
;; deb-view should work on any platform with the ar command, although
;; "ar -p" doesn't seem to work for .deb files on Solaris 2.4 and 2.5.
;; It works on Solaris 2.6, SGI's IRIX 6.1 and 6.2, and Linux, of course.

;; Old-style .deb files require the dpkg-deb program. I don't know how to
;; extract control.tar.gz from these deb files, so you only get to see
;; the package control file, but nothing else such as the install scripts.
;; If you know how to get the control.tar.gz file out, let me know!
;; The data file is still viewable thanks to the "dpkg-deb --fsys-tarfile"
;; option.

;;; Installation:

;; 1) Quick test to see if you like deb-view.

;; Put this file in your home directory, and call it deb-view.el.
;; Start up emacs and do the following:
;;      ESCAPE x load-file RETURN ~/deb-view.el RETURN
;; Then, view a deb file with CTRL-d in Dired mode,
;; or execute:
;;      ESCAPE x deb-view RETURN {/full/path/of/file.deb} RETURN
;; or execute:
;;      ESCAPE : (setq deb-find-directory "/your/debian/directory") RETURN
;;      ESCAPE x deb-find RETURN {deb-file-search-string} RETURN
;;      and select a deb file to view with RETURN or middle mouse button in
;;      the search results buffer that is created. Exit this buffer with "q".

;; 2) Permanent installation.

;; When installed this way, all find-file operations (such as "f" or "v" in
;; dired-mode) will automatically recognize debian files and load deb-view
;; when required.

;; Put this file somewhere where Emacs can find it (i.e., in one of the paths
;; in your `load-path'), `byte-compile-file' it, and put the following six
;; lines (with semi-colons removed) in your ~/.emacs file (or create ~/.emacs
;; if you don't have one):
;;(autoload 'deb-find            "deb-view" "Debian Archive File Finder" t)
;;(autoload 'deb-view-mode       "deb-view" "Debian Archive File Mode" t)
;;(autoload 'deb-view            "deb-view" "Debian Archive File Viewer" t)
;;(autoload 'deb-view-dired-view "deb-view" "Debian Archive File Viewer" t)
;;(setq auto-mode-alist (append '(("\\.deb$" . deb-view-mode)) auto-mode-alist))
;;(define-key dired-mode-map     "\C-d"     'deb-view-dired-view)

;; If you're not very familiar with emacs customization, here is a simpler
;; approach. Add this line to your ~/.emacs file (or create ~/.emacs if you
;; don't have one):
;;     (load "~/deb-view.el")
;; Or, if you can put deb-view into your load-path (execute
;; "^h v load-path RETURN" to see your load-path setting)
;; then just add the following to your ~./emacs file:
;;     (require 'deb-view)

;; deb-view is mostly unobtrusive, but does bind ^d in dired to
;; deb-view-dired-view.  The "debview" mode is derived from
;; tar-mode.el using derived.el. Compared to tar-mode, debview-mode
;; binds q, N, W, and re-binds v. Also, the normal editing and saving
;; features of tar-mode are not supported by debview mode and those
;; keys are disabled.

;; 3) Configuration

;; deb-find has two variables to set. deb-find-method can be "locate" or
;; "find". Any other value will be assumed to be an external script or
;; program that you supply. If you set deb-find-method to "find" then you
;; must also set deb-find-directory to the directory containing the
;; debian distribution. The find command starts at this point. I originally
;; used the locate option, but contrary to the man page it doesn't seem to
;; understand even simple regular expressions. I prefer the find option. It
;; uses egrep and therefore understands complex regular expressions.
;; You might want to bind deb-find to a special key. I use ^C^D like this:
;; (define-key ctl-x-map "\C-d" 'deb-find)
;; Note that this key is normally the brief list-directory command, a
;; command that I never used anyway.


;;; Usage:

;; In dired, press f or e on the dired line of the .deb file to view.
;; You can also use ^d, which is actually slightly faster since the
;; deb file isn't loaded into a buffer needlessly.

;; Or, execute: ESCAPE x deb-view RETURN, and enter the .deb file name
;; at the prompt.

;; Or, execute: ESCAPE x deb-find RETURN, and enter any substring of a
;; deb file name to search for. A buffer of matches is created.
;; Launch deb-view by selecting a deb file with the middle mouse button,
;; or RETURN or ^c^c. Exit this buffer with "q".

;; You are shown two tar files in debview-mode (see tar-mode for help).
;; In the case of old .deb format files, the control info is shown
;; but not the other files of control.tar, such as install scripts.
;; Note that regular tar-mode commands e, f and RETURN show raw files
;; without any special uncompressing or formatting.
;; Additional features that deb-view adds to tar-mode:
;; q - kill both view buffers (INFO and DATA) and return to the
;;     dired buffer if that's where you executed deb-mode.
;; v - executes deb-view-tar-view instead of tar-view, with the
;;     additional smarts to uncompress .gz and .Z files for viewing.
;; N - Like in dired, formats man pages for viewing, with the
;;     additional smarts to uncompress .gz and .Z man files for viewing.
;; W - use w3-mode to view an HTML file.

;; To view files not supported by deb-view, such as graphics, use the
;; copy command ("c") to copy the file to a temp directory.  You can
;; then do what you want to the file.


;;; History:
;; 

;; 1.3  - modified logic that determines old or new style Debian packages.
;;        On systems where the file command recognizes debian files, it
;;        wrongly always came up with old format.

;; 1.4  - added missing semicolons in the comments for Changelog 1.3.
;;      - fixed various spacing issues in doc strings.
;;      - disabled tar-mode keys that are not applicable to deb-view.

;; 1.5  - added an auto-mode-alist and deb-view mode so that deb-view
;;        is launched from any find-file command.
;;      - added a deb-find command that takes a search string and creates
;;        a buffer of matching deb files. ^C^C, RETURN or middle mouse button
;;        runs deb-view on the selected deb file.
;;      - added deb-view-help to "?" key in deb-view.

;; 1.6  - improved doc strings for deb-find and deb-find-method.
;;      - added (provide 'deb-view) and instructions for using
;;        (require 'deb-view).
;;      - reworked the documentation somewhat, but it's still too long.
;;      - changed the copyright notice to refer to deb-view, not Emacs.

;; 1.7  - make copy of compilation-minor-mode map rather than changing
;;        it directly. It was breaking actual compilation buffer keymaps,
;;        such as grep mode.

;; 1.8  - fixed deb-find when deb-find-method is set to "find". It wasn't
;;        adding "/*" to the end of the directory name for the find command.

;; 1.9  - Added support for handling remote deb files (ange-ftp).
;;      - reworked to use derived.el instead of messing with tar-mode
;;        directly. (Thanks to era eriksson )

;; 1.10 2003-10-30
;;  - New maintainer: Peter S. Galbraith 
;;  - checkdoc edits.
;;  - made defvars into defcustoms.

;; 1.11 2004-01-16  Peter S. Galbraith 
;;  - Resize top (control) window to fit number of lines since it
;;    doesn't really need to be 1/2 the screen.  Thanks to Dan
;;    Jacobson for suggesting this change (Closes: #224950).

;; 1.12 2005-10-24  Peter S. Galbraith 
;;  - Output an error message if the package file is corrupted
;;    (e.g. partial download).
;;    Thanks to Dan Jacobson for suggesting this change (Closes: #235673).
;;  - deb-view-dired-view: Check if file in dired is a .deb before opening.
;;    Thanks to Dan Jacobson for suggesting this change (Closes: #273902)
;;  - deb-view-tar-view: If the file to be opned is from the INFO buffer,
;;    then open in the other (larger) window.
;;    Thanks to Dan Jacobson for suggesting this change (Closes: #321869)

;; 1.13 2006-02-02 Sven Joachim 
;;    Bug fix for UTF-8 (Closes: #344260)
;;    The `call-process' and `call-process-region' use
;;    default-process-coding-system rather than coding-system-for-read.
;;    The former is set to '(mule-utf-8 . mule-utf-8) in my setup, and that
;;    caused the problem.  So the solution is to bind
;;    default-process-coding-system as well in deb-view-process

;; 1.14 2009-10-25  Peter S. Galbraith 
;;    Added support for data.tar.bz2 deb files (Closes: #457094).

;; 1.15 2009-11-02  Peter S. Galbraith 
;;    Fixed stupid bug "deb-view.el fails on own debian-el_30.9-1_all.deb",
;;    thanks to Kevin Ryde (Closes: #554039).

;; 1.16 2011-08-16  Peter S. Galbraith 
;;    Added support for data.tar.xz deb files (Closes: #637579).

;;; Code:

(defgroup deb-view nil
  "View Debian package files with tar-mode"
  :group 'tools
  :prefix "deb-view")

(defcustom deb-view-tar-uncompress-program "gzip -cd"
  "*Program to use for uncompression of .gz and .Z files in `deb-view'."
  :group 'deb-view
  :type 'string)

;; Note the following useful variable from tar-mode:
;;(defvar tar-mode-show-date nil
;; "*Non-nil means Tar mode should show the date/time of each subfile.
;;This information is useful, but it takes screen space away from file names.")

(defcustom deb-find-method "find"
  "Internal `deb-find' methods supported: locate or find.
Any other entry is assumed to be an external command.
See also the variable deb-find-directory."
  :group 'deb-view
  :type '(radio (const "find") (const "locate")))

(defcustom deb-find-directory "/usr/local/src/debian"
  "Directory to run find in when deb-find-method is \"find\"."
  :group 'deb-view
  :type 'directory)

(define-derived-mode debview-mode tar-mode "debview"
  "Major mode for debview.\n\n\\{debview-mode-map}")

;; Prohibit things that tar-mode does that deb-view doesn't:
(define-key debview-mode-map "\C-d" 'undefined)
(define-key debview-mode-map "G"    'undefined)
(define-key debview-mode-map "M"    'undefined)
(define-key debview-mode-map "O"    'undefined)
(define-key debview-mode-map "d"    'undefined)
(define-key debview-mode-map "g"    'undefined)
(define-key debview-mode-map "r"    'undefined)
(define-key debview-mode-map "u"    'undefined)
(define-key debview-mode-map "x"    'undefined)
(define-key debview-mode-map ""   'undefined)
             
(define-key debview-mode-map "?"    'deb-view-help)
(define-key debview-mode-map "q"    'deb-view-dired-view-cleanup)
(define-key debview-mode-map "N"    'deb-view-tar-man)
(define-key debview-mode-map "W"    'deb-view-tar-w3)
(define-key debview-mode-map "v"    'deb-view-tar-view)
(define-key debview-mode-map [up]   'tar-previous-line)
(define-key debview-mode-map [down] 'tar-next-line)
(define-key debview-mode-map "\eOA" 'tar-previous-line)
(define-key debview-mode-map "\eOB" 'tar-next-line)
(define-key debview-mode-map "\e[A" 'tar-previous-line)
(define-key debview-mode-map "\e[B" 'tar-next-line)

(defvar deb-view-dired-view-return-buffer ""
  "Return to this buffer after deb-view-dired-view-cleanup is called.")
(make-variable-buffer-local 'deb-view-dired-view-return-buffer)

(defvar deb-view-tempfile ""
  "Flag saying if the deb file is temporary (ange-ftp) and needs deleting.")

(defvar deb-view-file-name ""
  "The file name being processed by `deb-view'.")

;; You might not like the key bindings that I chose:
(if (featurep 'dired)
    (define-key dired-mode-map "\C-d" 'deb-view-dired-view)
  (add-hook
   'dired-load-hook
   (function (lambda ()
               (define-key dired-mode-map "\C-d" 'deb-view-dired-view)))))

;;;###autoload
(defun deb-view-dired-view ()
  "View Debian package control and data files.
Press \"q\" in either window to kill both buffers
and return to the dired buffer. See deb-view."
  (interactive)
  (let  ((file (dired-get-filename)))
    (if (string-match ".deb$" file)
        (deb-view file)
      (error "Not a Debian package file"))))

;;;###autoload
(defun deb-view (debfile)
  "View Debian package DEBFILE's control and data files.
Press \"q\" in either window to kill both buffers.

In dired, press ^d on the dired line of the .deb file to view.
Or, execute: ESCAPE x deb-view RETURN, and enter the .deb file name
at the prompt."
  (interactive "fdeb file to view: ")
  (if (and (or (string-match "Lucid" emacs-version)
 	       (string-match "XEmacs" emacs-version))
 	   (>= emacs-major-version 21))
      (require 'view-less)
    (require 'view))
  (require 'view)
  (if (< (nth 1 (file-attributes debfile)) 0)
      (progn
        ;; This is a remote file.
        ;; Call view-file to force ange-ftp to get it first.
        (message "deb-view remote file: %s" debfile)
        (find-file debfile))
    ;; This is a local file.
    (setq debfile (expand-file-name debfile))
    ;;(message "deb-view local file: %s" debfile)
    (setq deb-view-file-name debfile)
    (setq deb-view-tempfile nil)
    (deb-view-process debfile)))

(defun deb-view-process (debfile)
  "View Debian Archive Files for package DEBFILE."
  (let* ((deb-view-buffer-name (file-name-nondirectory deb-view-file-name))
         (info-buffer-name (concat deb-view-buffer-name "-INFO"))
         (data-buffer-name (concat deb-view-buffer-name "-DATA"))
         (info-buffer (progn (and (get-buffer info-buffer-name)
                                  (kill-buffer (get-buffer info-buffer-name)))
                             (get-buffer-create info-buffer-name)))
         (data-buffer (progn (and (get-buffer data-buffer-name)
                                  (kill-buffer (get-buffer data-buffer-name)))
                             (get-buffer-create data-buffer-name)))
         (return-buffer (current-buffer))
	 (coding-system-for-read 'no-conversion)
         (default-process-coding-system '(no-conversion . no-conversion))
	 file-buffer
         new-archive-format)
    (message "deb-view processing deb file %s..." deb-view-buffer-name)
    ;; info
    (setq file-buffer (get-buffer-create " *file-data*"))
    (setq new-archive-format
          (save-excursion
            (set-buffer file-buffer)
            (erase-buffer)
            (call-process shell-file-name nil t nil shell-command-switch
                          (concat "file " debfile))
            (goto-char 1)
            (if (string-match "archive" (buffer-string))
                t
              (goto-char 1)
              (if (string-match "old debian" (buffer-string))
                  nil
                t))))
    (kill-buffer file-buffer)
    (set-buffer info-buffer)
    (cond
     (new-archive-format
      ;; New deb format (archive)
      (call-process shell-file-name nil t nil shell-command-switch
                    (concat "ar -p " debfile
                            " control.tar.gz | gzip -cd"))
      (goto-char 1)
      (setq buffer-file-name (concat deb-view-file-name "-INFO"))
      (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))
      (debview-mode)
      ;; Turn off view-mode in this buffer:
      (make-variable-buffer-local 'view-mode-hook)
      (add-hook
       'view-mode-hook
       (function (lambda ()
                   (view-mode -1)
                   (setq view-exit-action 'deb-view-dired-view-cleanup))))
      (message "deb-view processing deb file %s..." deb-view-buffer-name)
      (tar-next-line 1)
      (switch-to-buffer info-buffer t))
     (t
      ;; Old deb format
      (message "deb-view old dpkg binary format")
      (call-process shell-file-name nil t nil shell-command-switch
                    (concat "dpkg-deb -I " debfile))
      (setq buffer-read-only t)
      (set-buffer-modified-p nil)
      (goto-char 1)
      (switch-to-buffer info-buffer t)
      (view-mode-enter return-buffer 'deb-view-dired-view-cleanup)))
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)
    (setq deb-view-dired-view-return-buffer return-buffer)
    (delete-other-windows)
    ;; data
    (set-buffer data-buffer)
    (buffer-disable-undo)
    (cond
     (new-archive-format
      (call-process "ar" nil '(t t) nil "-t" debfile)
      (goto-char 1)
      (cond
       ((re-search-forward "data.tar.gz" nil t)
        (erase-buffer)
        (call-process "ar" nil '(t t) nil "-p" debfile "data.tar.gz")
        (goto-char (point-max))
        (when (search-backward "is not a valid archive" nil t)
          (kill-buffer data-buffer)
          (kill-buffer info-buffer)        
          (error "%s: Not a valid package file" deb-view-buffer-name))
        (call-process-region (point-min) (point-max) "gzip" t t nil "-cd"))
       ((and (goto-char 1)(re-search-forward "data.tar.bz2" nil t))
        (erase-buffer)
        (call-process "ar" nil '(t t) nil "-p" debfile "data.tar.bz2")
        (goto-char (point-max))
        (when (search-backward "is not a valid archive" nil t)
          (kill-buffer data-buffer)
          (kill-buffer info-buffer)        
          (error "%s: Not a valid package file" deb-view-buffer-name))
        (call-process-region (point-min) (point-max) "bzip2" t t nil "-cd"))
       ((and (goto-char 1)(re-search-forward "data.tar.xz" nil t))
        (erase-buffer)
        (call-process "ar" nil '(t t) nil "-p" debfile "data.tar.xz")
        (goto-char (point-max))
        (when (search-backward "is not a valid archive" nil t)
          (kill-buffer data-buffer)
          (kill-buffer info-buffer)        
          (error "%s: Not a valid package file" deb-view-buffer-name))
        (call-process-region (point-min) (point-max) "xz" t t nil "-cd"))))
     (t      
      (call-process shell-file-name nil t nil shell-command-switch
                    (concat "dpkg-deb --fsys-tarfile " debfile))))
    (goto-char 1)
    (setq buffer-file-name (concat deb-view-file-name "-DATA"))
    (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))
    (debview-mode)
    (message "deb-view processing deb file %s..." deb-view-buffer-name)
    (tar-next-line 1)
    (setq deb-view-dired-view-return-buffer return-buffer)
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)
    (buffer-enable-undo)
    (switch-to-buffer-other-window data-buffer)
    (if new-archive-format (other-window 1))
    (shrink-window-if-larger-than-buffer)
    (when deb-view-tempfile
      (message "deb-view deleting tempfile: %s" debfile)
      (delete-file debfile))
    (message "deb-view: ? for help. q to quit.")))

;;;###autoload
(defun deb-view-mode ()
  "View mode for Debian Archive Files."
  (interactive)
  (let ((debfile buffer-file-name)
        (return-buffer (nth 0 (buffer-list)))
        (curbuf (current-buffer)))
    (setq deb-view-file-name debfile)
    (if (< (nth 1 (file-attributes debfile)) 0)
        (progn
          (message "deb-view remote file: %s" debfile)
          (setq debfile (make-temp-name "/tmp/deb-view."))
          ;;(message "deb-view processing deb file %s..." debfile)
          (write-file debfile)
          (setq deb-view-tempfile t))
      ;;(message "deb-view local file: %s" debfile)
      (setq deb-view-tempfile nil))
    (set-buffer return-buffer)
    (kill-buffer curbuf)
    (deb-view-process debfile)))

;;;###autoload
(defun deb-find ()
  "Search for deb files.
Use the method specified by the variable deb-find-method, and collect
output in a buffer.  See also the variable deb-find-directory.

This command uses a special history list, so you can
easily repeat a `deb-find' command."
  (interactive)
  (require 'compile)
  (let* ((deb-file-string (read-from-minibuffer "deb file to find: "
                                         nil nil nil 'deb-find-history))
         (output-buffer-name "*deb-find*")
         (command (cond ((string-equal deb-find-method "locate")
                         (concat "locate '" deb-file-string
                                 "' | egrep '\.deb$'"))
                        ((string-equal deb-find-method "find")
                         (concat "find " deb-find-directory "/* | egrep '"
                                 deb-file-string "' | egrep '\.deb$'"))
                        (t
                         (concat deb-find-method " '" deb-file-string "'")))))
    (compile-internal command "Not applicable in deb-find" "deb-find" nil nil
                      (function (lambda (mode) output-buffer-name)))
    (switch-to-buffer-other-window output-buffer-name)
    (setq deb-view-find-minor-mode-map
          (copy-keymap compilation-minor-mode-map))
    (use-local-map deb-view-find-minor-mode-map)
    (define-key deb-view-find-minor-mode-map [mouse-2]
      'deb-find-mouse-deb-view)
    (define-key deb-view-find-minor-mode-map "\C-c\C-c" 'deb-find-deb-view)
    (define-key deb-view-find-minor-mode-map "\C-m"     'deb-find-deb-view)
    (define-key deb-view-find-minor-mode-map "?"        'deb-find-help)
    (define-key deb-view-find-minor-mode-map "q"        'kill-this-buffer)
    (define-key deb-view-find-minor-mode-map "\M-n" 'undefined)
    (define-key deb-view-find-minor-mode-map "\M-p" 'undefined)
    (define-key deb-view-find-minor-mode-map "\M-{" 'undefined)
    (define-key deb-view-find-minor-mode-map "\M-}" 'undefined)
    (beginning-of-buffer)
    (message "deb-view: ? for help. q to quit.")))


;;; Internal functions:

(defvar deb-view-version "1.9"
  "The version of `deb-view'.")

(defun deb-view-version ()
  "Return string describing the version of `deb-view'.
When called interactively, displays the version."
  (interactive)
  (if (interactive-p)
      (message "deb-view version %s" (deb-view-version))
    deb-view-version))

(defun deb-view-dired-view-cleanup (&optional buffer)
  "Delete the buffers created by deb-view-dired-view."
  (interactive)
  (let* ((quit-buffer (or buffer (current-buffer)))
         (bufname (buffer-name quit-buffer))
         (debfile (substring bufname 0 (- (length bufname) 5)))
         (info-buffer (get-buffer (concat debfile "-INFO")))
         (data-buffer (get-buffer (concat debfile "-DATA")))
         (ddir-buffer (save-excursion
                        (set-buffer quit-buffer)
                        deb-view-dired-view-return-buffer)))
    (delete-other-windows)
    (and (buffer-live-p info-buffer)
         (kill-buffer info-buffer))
    (and (buffer-live-p data-buffer)
         (kill-buffer data-buffer))
    (and (buffer-live-p quit-buffer)
         (kill-buffer quit-buffer))
    (and (buffer-live-p ddir-buffer)
         (switch-to-buffer ddir-buffer))))

(defun deb-find-help ()
  "Show help information for `deb-find'."
  (interactive)
  (with-output-to-temp-buffer "*Help*"
    (princ (format "deb-find mode:    version %s" (deb-view-version)))
    (princ "\n
RET     - view the deb file on this line with deb-view.
C-c C-c - view the deb file on this line with deb-view.
mouse-2 - view the deb file on this line with deb-view.
? - show deb-find-help.
q - quit deb-find.")
    (save-excursion
      (set-buffer standard-output)
      (help-mode))
    (print-help-return-message)))

(defun deb-view-help ()
  "Show help information for `deb-view'."
  (interactive)
  (with-output-to-temp-buffer "*Help*"
    (princ (format "deb-view mode:    version %s" (deb-view-version)))
    (princ "
Derived from tar-mode, with additional features for viewing deb files.
Execute \"^h m\" to see tar-mode bindings.

You are shown two tar files in tar-mode (see tar-mode for help).
In the case of old .deb format files, the control info is shown
but not the other files of control.tar, such as install scripts.

Note that regular tar-mode commands e, f and RETURN show raw files
without any special uncompressing or formatting.

Additional features that deb-view adds to tar-mode:
? - show deb-view help.
q - kill both view buffers (INFO and DATA) and return to the
    dired buffer if that's where you executed deb-mode.
v - executes deb-view-tar-view instead of tar-view, with the
    additional smarts to uncompress .gz and .Z files for viewing.
N - Like in dired, formats man pages for viewing, with the
    additional smarts to uncompress .gz and .Z man files for viewing.
W - use w3-mode to view an HTML file.
These functions are also available in tar-mode on normal tar files
when deb-view is loaded.

To view files not supported by deb-view, such as graphics, use the
copy command in tar-mode (\"c\") to copy the file to a temp directory.
You can then do what you want to the file.")
    (save-excursion
      (set-buffer standard-output)
      (help-mode))
    (print-help-return-message)))

(defun deb-view-tar-man ()
  "*In Tar mode, view the tar file entry on this line as a man page."
  (interactive)
  (require 'man)
  (let ((auto-mode-alist
         (append '(("\\.gz$" . deb-view-tar-uncompress-while-visiting)
                   ("\\.Z$"  . deb-view-tar-uncompress-while-visiting)
                   ) auto-mode-alist)))
    (tar-extract 'view)
    (setq buffer-read-only nil)
    (shell-command-on-region (point-min) (point-max) "nroff -man -h " t t)
    (Man-cleanup-manpage)
    (setq buffer-read-only t)
    (set-buffer-modified-p nil)
    (message "")))

(defun deb-view-tar-uncompress-while-visiting ()
  "Temporary \"major mode\" used for .Z and .gz files, to uncompress them.
It then selects a major mode from the uncompressed file name and contents.
\(Modifed uncompress-while-visiting from uncompress.el\)"
  (interactive)
  (message "Uncompressing...")
  (let ((buffer-read-only nil))
    (shell-command-on-region (point-min) (point-max)
                             deb-view-tar-uncompress-program t))
  (message "Uncompressing...done")
  (set-buffer-modified-p nil)
  (goto-char 1))

(defun deb-view-tar-view ()
  "*In Tar mode, view the tar file entry on this line.
If the file is from the INFO buffer, then open in the other (larger) window."
  (interactive)
  (let ((auto-mode-alist
         (append '(("\\.gz$" . deb-view-tar-uncompress-while-visiting)
                   ("\\.Z$"  . deb-view-tar-uncompress-while-visiting)
                   ) auto-mode-alist)))
    (if (string-match "INFO$" buffer-file-name)
        (tar-extract-other-window)
      (tar-extract 'view))))

(defun deb-view-tar-w3 ()
  "*In Tar mode, view the tar file entry on this line as HTML with w3-mode."
  (interactive)
  (if (fboundp 'w3-preview-this-buffer)
      (let ((auto-mode-alist
             (append '(("\\.gz$" . deb-view-tar-uncompress-while-visiting)
                       ("\\.Z$"  . deb-view-tar-uncompress-while-visiting)
                       ) auto-mode-alist)))
        (tar-extract 'view)
        (rename-buffer (concat " " (buffer-name)))
        (w3-preview-this-buffer)
        (define-key w3-mode-map "q"	'deb-view-tar-w3-quit))
    (error "Sorry, you don't seem to have w3 loaded")))

(defun deb-view-tar-w3-quit ()
  "Quit WWW mode in a buffer from `deb-view'."
  (interactive)
  (let ((x w3-current-last-buffer))
    (and (fboundp 'w3-mpeg-kill-processes) (w3-mpeg-kill-processes))
    (kill-buffer (current-buffer))
    (if (and (bufferp x) (buffer-name x))
	(if w3-mutable-windows (pop-to-buffer x) (switch-to-buffer x))))
  (view-exit))

(defvar deb-find-history nil
  "History list for `deb-find' commands.")

(defvar deb-find-regexp "^/.*\.deb$"
  "Regexp for deb file names in the `deb-find' buffer.")

(defun deb-find-deb-view ()
  "Run `deb-view' in package under point."
  (interactive)
  (let ((deb-file (thing-at-point 'filename)))
    (if (and deb-file
             (string-match deb-find-regexp deb-file))
        (deb-view (thing-at-point 'filename))
      (error "No deb file on this line"))))

(defun deb-find-mouse-deb-view (event)
  "Run `deb-view' in package under mouse EVENT."
  (interactive "e")
  (pop-to-buffer (window-buffer (posn-window (event-end event))))
  (goto-char (posn-point (event-end event)))
  (let ((deb-file (thing-at-point 'filename)))
    (if (and deb-file
             (string-match deb-find-regexp deb-file))
        (deb-view (thing-at-point 'filename))
      (error "No deb file on this line"))))

(provide 'deb-view)

;;; deb-view.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/debian-el/debian-el-loaddefs.el0000775000000000000000000001164612230377265021702 0ustar  ;;; debian-el-loaddefs.el --- automatically extracted autoloads
;;
;;; Code:

(provide 'debian-el-loaddefs)

;;;### (autoloads (apt-sources-mode) "apt-sources" "apt-sources.el"
;;;;;;  (19215 18611))
;;; Generated autoloads from apt-sources.el

(autoload 'apt-sources-mode "apt-sources" "\
Major mode for editing apt's sources.list file.
Sets up command `font-lock-mode'.

\\{apt-sources-mode-map}

\(fn)" t nil)

;;;***

;;;### (autoloads (apt-utils-search apt-utils-show-package) "apt-utils"
;;;;;;  "apt-utils.el" (18850 53763))
;;; Generated autoloads from apt-utils.el

(autoload 'apt-utils-show-package "apt-utils" "\
Show information for a Debian package.
A selection of known packages is presented.  See `apt-utils-mode'
for more detailed help.  If NEW-SESSION is non-nil, generate a
new `apt-utils-mode' buffer.

\(fn &optional NEW-SESSION)" t nil)

(autoload 'apt-utils-search "apt-utils" "\
Search Debian packages for regular expression.
To search for multiple patterns use a string like \"foo && bar\".
The regular expression used to split the
terms (`apt-utils-search-split-regexp') is customisable.

\(fn)" t nil)

;;;***

;;;### (autoloads (deb-find deb-view-mode deb-view deb-view-dired-view)
;;;;;;  "deb-view" "deb-view.el" (19183 30392))
;;; Generated autoloads from deb-view.el

(autoload 'deb-view-dired-view "deb-view" "\
View Debian package control and data files.
Press \"q\" in either window to kill both buffers
and return to the dired buffer. See deb-view.

\(fn)" t nil)

(autoload 'deb-view "deb-view" "\
View Debian package DEBFILE's control and data files.
Press \"q\" in either window to kill both buffers.

In dired, press ^d on the dired line of the .deb file to view.
Or, execute: ESCAPE x deb-view RETURN, and enter the .deb file name
at the prompt.

\(fn DEBFILE)" t nil)

(autoload 'deb-view-mode "deb-view" "\
View mode for Debian Archive Files.

\(fn)" t nil)

(autoload 'deb-find "deb-view" "\
Search for deb files.
Use the method specified by the variable deb-find-method, and collect
output in a buffer.  See also the variable deb-find-directory.

This command uses a special history list, so you can
easily repeat a `deb-find' command.

\(fn)" t nil)

;;;***

;;;### (autoloads (debian-bug emacs-bug-get-bug-as-email debian-bug-get-bug-as-email
;;;;;;  debian-bug-get-bug-as-file debian-bug-web-package debian-bug-web-packages
;;;;;;  debian-bug-web-this-bug-under-mouse emacs-bug-web-bug debian-bug-web-bug
;;;;;;  debian-bug-web-developer-page debian-bug-web-bugs debian-bug-intent-to-package
;;;;;;  debian-bug-request-for-package debian-bug-wnpp) "debian-bug"
;;;;;;  "debian-bug.el" (19428 39961))
;;; Generated autoloads from debian-bug.el

(autoload 'debian-bug-wnpp "debian-bug" "\
Submit a WNPP bug report to Debian.
Optional argument ACTION can be provided in programs.

\(fn &optional ACTION)" t nil)

(autoload 'debian-bug-request-for-package "debian-bug" "\
Shortcut for `debian-bug-wnpp' with RFP action.

\(fn)" t nil)

(autoload 'debian-bug-intent-to-package "debian-bug" "\
Shortcut for `debian-bug-wnpp' with ITP action (for Debian developers).

\(fn)" t nil)

(autoload 'debian-bug-web-bugs "debian-bug" "\
Browse the BTS for this package via `browse-url'.
With optional argument prefix ARCHIVED, display archived bugs.

\(fn &optional ARCHIVED)" t nil)

(autoload 'debian-bug-web-developer-page "debian-bug" "\
Browse the web for this package's developer page.

\(fn)" t nil)

(autoload 'debian-bug-web-bug "debian-bug" "\
Browse the BTS for BUG-NUMBER via `browse-url'.

\(fn &optional BUG-NUMBER)" t nil)

(autoload 'emacs-bug-web-bug "debian-bug" "\
Browse the Emacs BTS for BUG-NUMBER via `browse-url'.

\(fn &optional BUG-NUMBER)" t nil)

(autoload 'debian-bug-web-this-bug-under-mouse "debian-bug" "\
Browse the BTS via `browse-url' for the bug report number under mouse.
In a program, mouse location is in EVENT.

\(fn EVENT)" t nil)

(autoload 'debian-bug-web-packages "debian-bug" "\
Search Debian web page for this package via `browse-url'.

\(fn)" t nil)

(autoload 'debian-bug-web-package "debian-bug" "\
Search Debian web page in ARCHIVE for this package via `browse-url'.

\(fn ARCHIVE)" t nil)

(autoload 'debian-bug-get-bug-as-file "debian-bug" "\
Read bug report #BUG-NUMBER as a regular file.

\(fn &optional BUG-NUMBER)" t nil)

(autoload 'debian-bug-get-bug-as-email "debian-bug" "\
Read bug report #BUG-NUMBER via Email interface.

\(fn &optional BUG-NUMBER)" t nil)

(autoload 'emacs-bug-get-bug-as-email "debian-bug" "\
Read Emacs bug report #BUG-NUMBER via Email interface.

\(fn &optional BUG-NUMBER)" t nil)

(autoload 'debian-bug "debian-bug" "\
Submit a Debian bug report.

\(fn)" t nil)

;;;***

;;;### (autoloads nil nil ("debian-el.el" "gnus-BTS.el") (19428 40248
;;;;;;  570272))

;;;***

;;;### (autoloads (preseed-mode) "preseed" "preseed.el" (17245 35005))
;;; Generated autoloads from preseed.el

(autoload (quote preseed-mode) "preseed" "\
Major mode for editing debian-installer preseed files colourfully." t nil)

;;;***
emacs-goodies-el-35.8ubuntu2/elisp/debian-el/apt-utils.el0000775000000000000000000024413112230377265020222 0ustar  ;;; apt-utils.el --- Emacs interface to APT (Debian package management)

;;; Copyright (C) 2002-2010 Matthew P. Hodges

;; Author: Matthew P. Hodges 
;;	$Id: apt-utils.el,v 1.22 2011-06-24 16:34:46 psg Exp $

;; apt-utils.el 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 2, or (at
;; your option) any later version.

;; apt-utils.el 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.

;;; Commentary:
;;
;; Package to interface Emacs with APT.  Start things off using e.g.:
;; M-x apt-utils-show-package RET emacs21 RET
;;
;; Other packages (dependencies, conflicts etc.) can be navigated
;; using apt-utils-{next,previous}-package,
;; apt-utils-choose-package-link or apt-utils-follow-link.  Return to
;; the previous package with apt-utils-view-previous-package.
;; ChangeLog and README files for the current package can easily be
;; accessed with, for example, apt-utils-view-changelog.
;;
;; For normal (i.e., not virtual) packages, the information can be
;; toggled between `package' and `showpkg' displays using
;; apt-utils-toggle-package-info; the latter is useful for the
;; "Reverse Depends".
;;
;; View the key bindings with describe-mode (bound to ? by default).

;;; Code:

(defconst apt-utils-version "2.12.0"
  "Version number of this package.")

(require 'browse-url)
(require 'jka-compr)

(defalias 'apt-utils-puthash 'puthash)

;; Customizable variables

(defgroup apt-utils nil
  "Emacs interface to APT (Debian package management)."
  :group 'tools
  :link '(url-link "http://mph-emacs-pkgs.alioth.debian.org/AptUtilsEl.html"))

(defcustom apt-utils-fill-packages t
  "*Fill APT package names if t."
  :group 'apt-utils
  :type 'boolean)

(defcustom apt-utils-show-link-info t
  "*Show APT package descriptions when cycling through links if t."
  :group 'apt-utils
  :type 'boolean)

(defcustom apt-utils-show-all-versions nil
  "*Show APT descriptions for multiple package versions if t."
  :group 'apt-utils
  :type 'boolean)

(defcustom apt-utils-automatic-update 'ask
  "*Controls automatic rebuilding of APT package lists.

If t always rebuilt when `apt-utils-timestamped-file' is newer
than the timestamp stored in `apt-utils-package-list-built'.  If
equal to the symbol ask, ask the user about the update.  If nil,
never update automatically."
  :group 'apt-utils
  :type '(choice (const :tag "Always update automatically" t)
                 (const :tag "Ask user about update" ask)
                 (const :tag "Never update automatically" nil)))

(defcustom apt-utils-grep-dctrl-args '("-e")
  "*List of arguments to pass to `apt-utils-grep-dctrl-program'."
  :group 'apt-utils
  :type '(repeat string))

(defcustom apt-utils-kill-buffer-confirmation-function 'yes-or-no-p
  "Function called before killing any buffers.
The function is called with one argument, which is a prompt.
Suitable non-nil values include `yes-or-no-p', `y-or-n-p' and
`ignore'."
  :group 'apt-utils
  :type '(choice (const :tag "Kill buffers only after yes or no query" yes-or-no-p)
                 (const :tag "Kill buffers only after y or n query" y-or-n-p)
                 (const :tag "Never kill buffers" ignore)
                 (const :tag "Kill buffers without confirmation" nil)))

(defcustom apt-utils-search-split-regexp "\\s-*&&\\s-*"
  "Regular expression used to split multiple search terms.
See `apt-utils-search' and `apt-utils-search-names-only'."
  :group 'apt-utils
  :type 'regexp)

(defcustom apt-utils-web-browse-debian-changelog-url
  "http://packages.debian.org/changelogs/pool/main/%d/%s/%s_%v/changelog"
  "Template URL for Debian ChangeLog files.
See `apt-utils-web-format-url'."
  :group 'apt-utils
  :type 'string)

(defcustom apt-utils-web-browse-bug-reports-url
  "http://bugs.debian.org/%p"
  "Template URL for Debian bug reports.
See `apt-utils-web-format-url'."
  :group 'apt-utils
  :type 'string)

(defcustom apt-utils-web-browse-copyright-url
  "http://packages.debian.org/changelogs/pool/main/%d/%s/%s_%v/%p.copyright"
  "Template URL for Debian copyright files.
See `apt-utils-web-format-url'."
  :group 'apt-utils
  :type 'string)

(defcustom apt-utils-web-browse-versions-url
  "http://packages.debian.org/%p"
  "Template URL for Debian version information.
See `apt-utils-web-format-url'."
  :group 'apt-utils
  :type 'string)

(defcustom apt-utils-show-package-hooks nil
  "Hooks to be run after presenting package information."
  :group 'apt-utils
  :type 'hook)

(defcustom apt-utils-use-current-window nil
  "If non-nil always display APT utils buffers in the current window.
In this case `switch-to-buffer' is used to select the APT utils
buffer.  If nil, `display-buffer' is used, and the precise
behaviour depends on the value of `pop-up-windows'."
  :group 'apt-utils
  :type 'boolean)

(defcustom apt-utils-dpkg-program "/usr/bin/dpkg"
  "Location of the dpkg program.
This can be set to dlocate, which has the advantage of better
performance, but uses cached data that may be out of date."
  :group 'apt-utils
  :type '(choice (const :tag "dpkg" "/usr/bin/dpkg")
                 (const : tag "dlocate" "/usr/bin/dlocate")
                 (file :must-match t)))

(defcustom apt-utils-display-installed-status t
  "If non-nil display the installed status of the current package."
  :group 'apt-utils
  :type 'boolean)

;; Faces

(defface apt-utils-normal-package-face
  '((((class color) (background light))
     (:foreground "blue"))
    (((class color) (background dark))
     (:foreground "yellow")))
  "Face used for APT normal package hyperlinks."
  :group 'apt-utils)

(defface apt-utils-normal-installed-package-face
  '((((class color))
     (:inherit apt-utils-normal-package-face :bold t)))
  "Face used for APT installed package hyperlinks."
  :group 'apt-utils)

(defface apt-utils-virtual-package-face
  '((((class color) (background light))
     (:foreground "green4"))
    (((class color) (background dark))
     (:foreground "green")))
  "Face used for APT virtual package hyperlinks."
  :group 'apt-utils)

(defface apt-utils-field-keyword-face
  '((((class color) (background light))
     (:foreground "purple" :bold t))
    (((class color) (background dark))
     (:foreground "purple" :bold t)))
  "Face used for APT field keywords."
  :group 'apt-utils)

(defface apt-utils-field-contents-face
  '((((class color) (background light))
     (:foreground "orchid"))
    (((class color) (background dark))
     (:foreground "orange")))
  "Face used for APT field contents."
  :group 'apt-utils)

(defface apt-utils-description-face
  '((((class color))
     (:foreground "cadet blue")))
  "Face used for APT package description."
  :group 'apt-utils)

(defface apt-utils-version-face
  '((((class color))
     (:italic t)))
  "Face used for APT package versions."
  :group 'apt-utils)

(defface apt-utils-broken-face
  '((((class color))
     (:foreground "red")))
  "Face used for unknown APT package."
  :group 'apt-utils)

(defface apt-utils-file-face
  '((((class color))
     (:foreground "brown")))
  "Face used for files."
  :group 'apt-utils)

(defface apt-utils-installed-status-face
  '((((class color))
     (:italic t)))
  "Face used for installed status."
  :group 'apt-utils)

;; Other variables

(defvar apt-utils-apt-cache-program "/usr/bin/apt-cache"
  "Location of the apt-cache program.")

(defvar apt-utils-grep-dctrl-program "/usr/bin/grep-dctrl"
  "Location of the grep-dctrl program.")

(defvar apt-utils-grep-dctrl-file-directory "/var/lib/apt/lists"
  "Directory used by `apt-utils-search-grep-dctrl'.
See also `apt-utils-grep-dctrl-file-list'.")

(defvar apt-utils-grep-dctrl-file-list nil
  "List of files searched by `apt-utils-search-grep-dctrl'.
If no list is specified, this is computed on demand from files in
`apt-utils-grep-dctrl-file-directory'.")

(defvar apt-utils-package-list nil
  "Hash table containing APT packages types.")

(defvar apt-utils-package-list-built nil
  "If non-nil, a timestamp for the APT package list data.")

(defvar apt-utils-package-history nil
  "History of packages for each `apt-utils-mode' buffer.")
(make-variable-buffer-local 'apt-utils-package-history)

(defvar apt-utils-current-links nil
  "Package links associated with the `apt-utils-mode' buffer.")
(make-variable-buffer-local 'apt-utils-current-links)

(defvar apt-utils-buffer-positions nil
  "Cache of positions associated with package history.
These are stored in a hash table.  See also
`apt-utils-package-history'")
(make-variable-buffer-local 'apt-utils-buffer-positions)

(defvar apt-utils-dired-buffer nil
  "Keep track of dired buffer.")

(defvar apt-utils-automatic-update-asked nil
  "Non-nil if user already asked about updating package lists.")

(defvar apt-utils-timestamped-file "/var/cache/apt/pkgcache.bin"
  "File to check timestamp of (see `apt-utils-automatic-update').")

;; XEmacs support

(defconst apt-utils-xemacs-p
  (or (featurep 'xemacs)
      (string-match "XEmacs\\|Lucid" (emacs-version)))
  "True if we are using apt-utils under XEmacs.")

;; Other version-dependent configuration

(defalias 'apt-utils-line-end-position
  (cond
   ((fboundp 'line-end-position) 'line-end-position)
   ((fboundp 'point-at-eol) 'point-at-eol)))

(defalias 'apt-utils-line-beginning-position
  (cond
   ((fboundp 'line-beginning-position) 'line-beginning-position)
   ((fboundp 'point-at-bol) 'point-at-bol)))

(defconst apt-utils-completing-read-hashtable-p
  ;; I think this is a valid way to check this feature...
  (condition-case nil
      (or (all-completions "" (make-hash-table)) t)
    (error nil))
  "Non-nil if `completing-read' supports hash table as input.")

(defconst apt-utils-face-property
  (if (with-temp-buffer
        ;; We have to rename to something without a leading space,
        ;; otherwise font-lock-mode won't get activated.
        (rename-buffer "*test-font-lock*")
        (font-lock-mode 1)
        (and (boundp 'char-property-alias-alist)
             (member 'font-lock-face
                     (assoc 'face char-property-alias-alist))))
      'font-lock-face
    'face)
  "Use font-lock-face if `add-text-properties' supports it.
Otherwise, just use face.")

(cond
 ;; Emacs 21
 ((fboundp 'replace-regexp-in-string)
  (defalias 'apt-utils-replace-regexp-in-string 'replace-regexp-in-string))
 ;; Emacs 20
 ((and (require 'dired)
       (fboundp 'dired-replace-in-string))
  (defalias 'apt-utils-replace-regexp-in-string 'dired-replace-in-string))
 ;; XEmacs
 ((fboundp 'replace-in-string)
  (defun apt-utils-replace-regexp-in-string (regexp rep string)
    (replace-in-string string regexp rep)))
 ;; Bail out
 (t
  (error "No replace in string function found")))

;; Commands and functions

;;;###autoload
(defun apt-utils-show-package (&optional new-session)
  "Show information for a Debian package.
A selection of known packages is presented.  See `apt-utils-mode'
for more detailed help.  If NEW-SESSION is non-nil, generate a
new `apt-utils-mode' buffer."
  (interactive "P")
  (let ((package (apt-utils-choose-package)))
    (when (> (length package) 0)
      (apt-utils-show-package-1 package t new-session))))

(defun apt-utils-show-package-1 (package-spec &optional interactive new-session)
  "Present Debian package information in a dedicated buffer.

PACKAGE-SPEC can be either a string (the name of the package) or
a list, where the car of the list is the name of the package, and
the cdr is the package type.

If INTERACTIVE is non-nil, then we have been called
interactively (or from a keyboard macro) via
`apt-utils-show-package'.  Hence, reset the history of visited
packages.

If NEW-SESSION is non-nil, generate a new `apt-utils-mode'
buffer."
  (apt-utils-check-package-lists)
  (let (package type)
    (cond ((and package-spec (listp package-spec))
           (setq package (car package-spec))
           (setq type (cdr package-spec)))
          ((stringp package-spec)
           (setq package package-spec
                 type (apt-utils-package-type package))))
    ;; Set up the buffer
    (cond
     (new-session
      (set-buffer (generate-new-buffer "*APT package info*"))
      (apt-utils-mode)
      (apt-utils-update-mode-name))
     ((eq major-mode 'apt-utils-mode)
      ;; do nothing
      )
     (t
      (set-buffer (get-buffer-create "*APT package info*"))
      (apt-utils-mode)))
    ;; If called interactively, initialize apt-utils-package-history
    (when (or interactive new-session)
      (setq apt-utils-package-history (cons (cons package type) nil))
      (if (hash-table-p apt-utils-buffer-positions)
          (clrhash apt-utils-buffer-positions)
        (setq apt-utils-buffer-positions (make-hash-table :test 'equal))))
    (let ((inhibit-read-only t))
      (erase-buffer)
      (cond
       ((memq type '(normal normal-installed))
        (call-process apt-utils-apt-cache-program nil '(t nil) nil "show" package)
        ;; Remove old versions if not wanted
        (unless apt-utils-show-all-versions
          (goto-char (point-min))
          (re-search-forward "^$")
          (unless (eobp)
            (delete-region (point) (point-max))))
        (apt-utils-add-package-links))
       ;; Virtual package or normal package w/ showpkg
       ((memq type '(virtual normal-showpkg))
        (call-process apt-utils-apt-cache-program nil '(t nil) nil "showpkg" package)
        (apt-utils-add-showpkg-links package))
       ;; Normal search
       ((equal type 'search)
        (insert (format "Debian package search for %s\n\n" package))
        (apply 'call-process apt-utils-apt-cache-program nil '(t nil) nil
               "search" "--"
               (split-string package apt-utils-search-split-regexp))
        (apt-utils-sort-result)
        (apt-utils-add-search-links 'search))
       ;; Search for names only
       ((equal type 'search-names-only)
        (insert (format "Debian package search (names only) for %s\n\n" package))
        (apply 'call-process apt-utils-apt-cache-program nil '(t nil) nil
               "search" "--names-only" "--"
               (split-string package apt-utils-search-split-regexp))
        (apt-utils-sort-result)
        (apt-utils-add-search-links 'search-names-only))
       ;; Search for file names
       ((equal type 'search-file-names)
        (insert (format "Debian package search (file names) for %s\n\n" package))
        (apply 'call-process apt-utils-dpkg-program nil t nil
               "-S" (list package))
        (apt-utils-sort-result)
        (apt-utils-add-search-links 'search-file-names))
       ;; grep-dctrl search
       ((equal type 'search-grep-dctrl)
        (insert (format "grep-dctrl search for %s\n\n"
                        (concat (format "\"%s\" " (car package))
                                (mapconcat 'identity (cdr package) " "))))
        (apply 'call-process apt-utils-grep-dctrl-program nil t nil package)
        (apt-utils-sort-result)
        ;; Don't check installed status; may take forever
        (let ((apt-utils-display-installed-status nil))
          (apt-utils-add-package-links))))
      (if apt-utils-use-current-window
          (switch-to-buffer (current-buffer))
        (select-window (display-buffer (current-buffer))))
      ;; Point only needs setting for new sessions or when choosing
      ;; new packages with apt-utils-follow-link or
      ;; apt-utils-choose-package-link.
      (goto-char (point-min))
      (run-hooks 'apt-utils-show-package-hooks)))
  (set-buffer-modified-p nil)
  (setq buffer-read-only t))

(defun apt-utils-list-package-files ()
  "List the files associated with the current package.
The list appears in a `dired-mode' buffer.  Only works for
installed packages; uses `apt-utils-dpkg-program'."
  (interactive)
  (let ((package (caar apt-utils-package-history))
        (type (cdar apt-utils-package-history))
        files)
    (setq files (apt-utils-get-package-files package))
    ;; Some meta packages contain only directories, so
    ;; apt-utils-get-package-files returns '("/."); however, we don't
    ;; want to list /.
    (when (equal files '("/."))
      (setq files nil))
    (cond
     ((memq type '(normal normal-showpkg normal-installed))
      (if files
          (progn
            ;; Some versions of Emacs won't update dired for the same
            ;; directory name if it already exists
            (if (buffer-live-p apt-utils-dired-buffer)
                (kill-buffer apt-utils-dired-buffer))
            (setq apt-utils-dired-buffer (dired-noselect files))
            (display-buffer apt-utils-dired-buffer))
        (message "Package does not contain any files/is not installed.")))
     (t
      (message "No files associated for type: %s." type)))))

(defalias 'apt-utils-view-package-files 'apt-utils-list-package-files)

(defun apt-utils-get-package-files (package &optional filter installed)
  "Return a list of files belonging to package PACKAGE.
With optional argument FILTER, return files matching this regular
expression.

With non-nil INSTALLED, return t if package is installed,
otherwise nil."
  (let (files)
    (catch 'installed
      (with-temp-buffer
        (call-process apt-utils-dpkg-program nil t nil "-L" package)
        ;; Check for files
        (cond
         ((or (search-backward "does not contain any files" nil t)
              (search-backward "not installed" nil t)
              ;; dlocate returns nothing for uninstalled packages
              (or (zerop (buffer-size))))
          (when installed
            (throw 'installed nil)))
         (installed
          (throw 'installed t))
         (t
          (setq files (split-string (buffer-string) "\n"))
          ;; Keep regular files or top directory (for dired)
          (setq files
                (delq nil
                      (mapcar (lambda (elt)
                                (if (and (or (file-regular-p elt)
                                             (string-equal "/." elt))
                                         (string-match (or filter ".") elt))
                                    elt
                                  nil))
                              files))))))
      files)))

(defun apt-utils-current-package-installed-p ()
  "Return non-nil if the current-package is installed."
  (apt-utils-get-package-files (caar apt-utils-package-history) nil t))

;;;###autoload
(defun apt-utils-search ()
  "Search Debian packages for regular expression.
To search for multiple patterns use a string like \"foo && bar\".
The regular expression used to split the
terms (`apt-utils-search-split-regexp') is customisable."
  (interactive)
  (apt-utils-search-internal 'search
                             "Search packages for regexp: "))

(defun apt-utils-search-names-only ()
  "Search Debian package names for regular expression.
To search for multiple patterns use a string like \"foo && bar\".
The regular expression used to split the
terms (`apt-utils-search-split-regexp') is customisable."
  (interactive)
  (apt-utils-search-internal 'search-names-only
                             "Search package names for regexp: "))

(defun apt-utils-search-file-names ()
  "Search Debian file names for string."
  (interactive)
  (apt-utils-search-internal 'search-file-names
                             "Search file names for string: "))

(defun apt-utils-search-internal (type prompt)
  "Search Debian packages for regular expression or string.
The type of search is specified by TYPE, the prompt for the
search is specified by PROMPT."
  (apt-utils-check-package-lists)
  (let ((regexp (read-from-minibuffer prompt)))
    ;; Set up the buffer
    (cond
     ((eq major-mode 'apt-utils-mode)
      ;; do nothing
      )
     (t
      (set-buffer (get-buffer-create "*APT package info*"))
      (apt-utils-mode)))
    (let ((inhibit-read-only t)
          result)
      (erase-buffer)
      ;; Can't search for string starting with "-" because the "--"
      ;; option isn't understood by dpkg or dlocate
      (when (and (eq type 'search-file-names)
                 (string-match "^-" regexp))
        (setq regexp (apt-utils-replace-regexp-in-string "^-+" "" regexp)))
      (insert (format "Debian package search%s for %s\n\n"
                      (cond ((eq type 'search-names-only) " (names only)")
                            ((eq type 'search-file-names) " (file names)")
                            (t ""))
                      regexp))
      (setq result
            (cond
             ((eq type 'search)
              (setq apt-utils-package-history (cons (cons regexp 'search) nil))
              (apply 'call-process apt-utils-apt-cache-program nil '(t nil) nil
                     "search" "--"
                     (split-string regexp apt-utils-search-split-regexp)))
             ((eq type 'search-names-only)
              (setq apt-utils-package-history (cons (cons regexp 'search-names-only) nil))
              (apply 'call-process apt-utils-apt-cache-program nil '(t nil) nil
                     "search" "--names-only" "--"
                     (split-string regexp apt-utils-search-split-regexp)))

             ((eq type 'search-file-names)
              (setq apt-utils-package-history (cons (cons regexp 'search-file-names) nil))
              (apply 'call-process apt-utils-dpkg-program nil t nil
                     "-S" (list regexp)))))
      (if (hash-table-p apt-utils-buffer-positions)
          (clrhash apt-utils-buffer-positions)
        (setq apt-utils-buffer-positions (make-hash-table :test 'equal)))
      (if (eq result 0)
          (apt-utils-add-search-links type)
        (if (hash-table-p apt-utils-current-links)
            (clrhash apt-utils-current-links)))
      (goto-char (point-min))
      ;; Sort results
      (apt-utils-sort-result)
      (set-buffer-modified-p nil)
      (setq buffer-read-only t)
      (display-buffer (current-buffer)))))

(defun apt-utils-search-grep-dctrl ()
  "Search Debian packages for regular expression using grep-dctrl."
  (interactive)
  (apt-utils-check-package-lists)
  (let (args
        (fields (apt-utils-read-fields "Search package fields: "))
        (show (apt-utils-read-fields "Show package fields: "))
        (regexp (read-from-minibuffer "Search regexp: ")))
    ;; Check args
    (cond
     ((equal (length fields) 0)
      (error "No fields selected for search"))
     ((equal (length show) 0)
      (error "No fields selected for show"))
     ((equal (length regexp) 0)
      (error "No regexp selected")))
    (setq fields (concat "-F" fields))
    (setq show (concat "-s" show))
    (cond
     ((eq major-mode 'apt-utils-mode)
      ;; do nothing
      )
     (t
      (set-buffer (get-buffer-create "*APT package info*"))
      (apt-utils-mode)))
    (let ((inhibit-read-only t)
          result)
      (erase-buffer)
      ;; Construct argument list (need to keep this)
      (setq args (append (list regexp fields show) apt-utils-grep-dctrl-args
                         (or apt-utils-grep-dctrl-file-list
                             (directory-files apt-utils-grep-dctrl-file-directory
                                              t "_Packages$"))))
      (insert (format "grep-dctrl search for %s\n\n"
                      (mapconcat
                       (lambda (elt)
                         (if (string-equal regexp elt)
                             (format "\"%s\"" regexp)
                           elt))
                       args " ")))
      (setq result
            (apply 'call-process
                   apt-utils-grep-dctrl-program nil t nil args))
      (setq apt-utils-package-history (cons (cons args 'search-grep-dctrl) nil))
      (if (hash-table-p apt-utils-buffer-positions)
          (clrhash apt-utils-buffer-positions)
        (setq apt-utils-buffer-positions (make-hash-table :test 'equal)))
      (if (eq result 0)
          (apt-utils-add-package-links)
        (if (hash-table-p apt-utils-current-links)
            (clrhash apt-utils-current-links)))
      (goto-char (point-min))
      (set-buffer-modified-p nil)
      (setq buffer-read-only t)
      (display-buffer (current-buffer)))))

(defun apt-utils-read-fields (prompt)
  "Read fields for `apt-utils-search-grep-dctrl'.
Use PROMPT for `completing-read'."
  (let ((chosen "foo")
        (completion-ignore-case t)
        ;; Why can't I use '(...) for the list?
        (keywords (list "Architecture" "Bugs" "Conffiles" "Conflicts"
                        "Depends" "Description" "Enhances" "Essential"
                        "Filename" "Installed-Size" "MD5sum" "Maintainer"
                        "Origin" "Package" "Pre-Depends" "Priority"
                        "Provides" "Recommends" "Replaces" "Section"
                        "Size" "Source" "Suggests" "Tag" "Task" "Version"
                        "url"))
        fields)
    (while (> (length chosen) 0)
      (setq chosen
            (completing-read prompt
                             (mapcar (lambda (elt)
                                       (list elt elt))
                                     keywords)
                             nil
                             t))
      (setq keywords (delete chosen keywords))
      (if (stringp fields)
          (progn
            (when (> (length chosen) 0)
              (setq fields (concat fields "," chosen))))
        (setq fields chosen)))
    fields))

(defun apt-utils-toggle-package-info ()
  "Toggle between package and showpkg info for normal packages."
  (interactive)
  (unless (equal major-mode 'apt-utils-mode)
    (error "Not in APT utils buffer"))
  (let ((package (caar apt-utils-package-history))
        (type (cdar apt-utils-package-history))
        posns)
    (cond
     ((memq type '(normal normal-installed))
      (setq posns (apt-utils-update-buffer-positions 'toggle))
      (setq apt-utils-package-history
            (cons (cons package 'normal-showpkg)
                  (cdr apt-utils-package-history)))
      (apt-utils-show-package-1 (car apt-utils-package-history) nil)
      (goto-char (car posns))
      (set-window-start (selected-window) (cadr posns)))
     ((equal type 'normal-showpkg)
      (setq posns (apt-utils-update-buffer-positions 'toggle))
      (setq apt-utils-package-history
            (cons (cons package 'normal)
                  (cdr apt-utils-package-history)))
      (apt-utils-show-package-1 (car apt-utils-package-history) nil)
      (goto-char (car posns))
      (set-window-start (selected-window) (cadr posns)))
     ((equal type 'virtual)
      (message "Cannot toggle info for virtual packages."))
     ((memq type '(search search-names-only
                          search-file-names
                          search-grep-dctrl))
      (message "Cannot toggle info for searches.")))))

(defun apt-utils-normal-package-p ()
  "Return non-nil if the current package is a normal package.
That is, not a normal-showpkg, search or a virtual package."
  (eq (cdar apt-utils-package-history) 'normal))

(defun apt-utils-toggle-package-p ()
  "Return non-nil if we can toggle between package and showpkg.
See also `apt-utils-toggle-package-info'."
  (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))

(defun apt-utils-check-package-lists ()
  "Determine whether package lists need rebuilding."
  (apt-utils-update-mode-name)
  (cond
   ((null apt-utils-package-list-built)
    (apt-utils-build-package-list))
   ((and (apt-utils-packages-needs-update)
         ;; Only act for non-nil apt-utils-automatic-update
         apt-utils-automatic-update
         (cond
          ((eq apt-utils-automatic-update t))
          ((eq apt-utils-automatic-update 'ask)
           (unless apt-utils-automatic-update-asked
             (setq apt-utils-automatic-update-asked t)
             (yes-or-no-p
              "APT package lists may be out of date. Update them? ")))))
    (apt-utils-build-package-list t))))

;; Find ChangeLog files

(defun apt-utils-view-changelog ()
  "Find ChangeLog for the current package."
  (interactive)
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (message "Not in APT utils buffer."))
   ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))
    (message "Not a normal package."))
   (t
    (let* ((package (caar apt-utils-package-history))
           (file (apt-utils-changelog-file package)))
      (if file
        (apt-utils-view-file file)
      (message "No ChangeLog file found for %s." package))))))

(defun apt-utils-changelog-file (&optional package)
  "Find ChangeLog file for PACKAGE or the current package."
  (unless package (setq package (caar apt-utils-package-history)))
  (let ((file
         (apt-utils-find-readable-file
          (format "/usr/share/doc/%s/" package)
          '("CHANGELOG" "ChangeLog" "Changelog" "changelog")
          '("" ".gz"))))
        file))

;; Find Debian ChangeLog files

(defun apt-utils-view-debian-changelog ()
  "Find Debian ChangeLog for the current package."
  (interactive)
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (message "Not in APT utils buffer."))
   ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))
    (message "Not a normal package."))
   (t
    (let* ((package (caar apt-utils-package-history))
           (file (apt-utils-debian-changelog-file package)))
      (if file
          (apt-utils-view-file file)
        (message "No Debian ChangeLog file found for %s." package))))))

(defun apt-utils-debian-changelog-file (&optional package)
  "Find Debian ChangeLog file for PACKAGE or the current package."
  (unless package (setq package (caar apt-utils-package-history)))
  (let ((file
         (apt-utils-find-readable-file
          (format "/usr/share/doc/%s/" package)
          '("changelog.Debian")
          '(".gz"))))
        file))

;; Find NEWS files

(defun apt-utils-view-news ()
  "Find NEWS for the current package."
  (interactive)
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (message "Not in APT utils buffer."))
   ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))
    (message "Not a normal package."))
   (t
    (let* ((package (caar apt-utils-package-history))
           (file (apt-utils-news-file package)))
      (if file
          (apt-utils-view-file file)
        (message "No NEWS file found for %s." package))))))

(defun apt-utils-news-file (&optional package)
  "Find NEWS file for PACKAGE or the current package."
  (unless package (setq package (caar apt-utils-package-history)))
  (let ((file
         (apt-utils-find-readable-file
          (format "/usr/share/doc/%s/" package)
          '("NEWS")
          '("" ".gz"))))
    file))

;; Find Debian NEWS files

(defun apt-utils-view-debian-news ()
  "Find Debian NEWS for the current package."
  (interactive)
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (message "Not in APT utils buffer."))
   ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))
    (message "Not a normal package."))
   (t
    (let* ((package (caar apt-utils-package-history))
           (file (apt-utils-debian-news-file package)))
      (if file
          (apt-utils-view-file file)
        (message "No Debian NEWS file found for %s." package))))))

(defun apt-utils-debian-news-file (&optional package)
  "Find Debian NEWS file for PACKAGE or the current package."
  (unless package (setq package (caar apt-utils-package-history)))
  (let ((file
         (apt-utils-find-readable-file
          (format "/usr/share/doc/%s/" package)
          '("NEWS.Debian")
          '(".gz"))))
    file))

;; Find README files

(defun apt-utils-view-readme ()
  "Find README for the current package."
  (interactive)
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (message "Not in APT utils buffer."))
   ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))
    (message "Not a normal package."))
   (t
    (let* ((package (caar apt-utils-package-history))
           (file (apt-utils-readme-file package)))
      (if file
          (apt-utils-view-file file)
        (message "No README file found for %s." package))))))

(defun apt-utils-readme-file (&optional package)
  "Find README file for PACKAGE or the current package."
  (unless package (setq package (caar apt-utils-package-history)))
  (let ((file
         (apt-utils-find-readable-file
          (format "/usr/share/doc/%s/" package)
          '("README" "readme")
          '("" ".gz"))))
    file))

;; Find Debian README files

(defun apt-utils-view-debian-readme ()
  "Find Debian README for the current package."
  (interactive)
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (message "Not in APT utils buffer."))
   ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))
    (message "Not a normal package."))
   (t
    (let* ((package (caar apt-utils-package-history))
           (file (apt-utils-debian-readme-file package)))
      (if file
          (apt-utils-view-file file)
        (message "No Debian README file found for %s." package))))))

(defun apt-utils-debian-readme-file (&optional package)
  "Find Debian README file for PACKAGE or the current package."
  (unless package (setq package (caar apt-utils-package-history)))
  (let ((file
         (apt-utils-find-readable-file
          (format "/usr/share/doc/%s/" package)
          '("README.Debian" "README.debian")
          '("" ".gz"))))
    file))

;; Find copyright files

(defun apt-utils-view-copyright ()
  "Find copyright file for the current package."
  (interactive)
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (message "Not in APT utils buffer."))
   ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))
    (message "Not a normal package."))
   (t
    (let* ((package (caar apt-utils-package-history))
           (file (apt-utils-copyright-file package)))
      (if file
          (apt-utils-view-file file)
        (message "No copyright file found for %s." package))))))

(defun apt-utils-copyright-file (&optional package)
  "Find copyright file for PACKAGE or the current package."
  (unless package (setq package (caar apt-utils-package-history)))
  (let ((file
         (apt-utils-find-readable-file
          (format "/usr/share/doc/%s/copyright" package)
          '("")
          '(""))))
    file))

(defun apt-utils-view-man-page ()
  "View man page for the current package.
If there is more than one man page associated with the package,
offer a choice."
  (interactive)
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (message "Not in APT utils buffer."))
   ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))
    (message "Not a normal package."))
   (t
    (let ((package (caar apt-utils-package-history))
          (regexp
           "^.*/man/\\([a-zA-Z_/.]+\\)?man[0-9]/\\(.*\\)\\.\\([0-9a-z]+\\)\\.gz")
          choice chosen files table)
      (setq files (apt-utils-get-package-files package
                                               "/man/.*\\.gz$"))
      (cond
       ((null files)
        (message "No man pages found for %s." package))
       ((not (cdr files))
        (setq chosen (car files)))
       (t
        (setq table (mapcar
                     (lambda (file)
                       (setq choice
                             (with-temp-buffer
                               (insert file)
                               (when (re-search-backward regexp nil t)
                                 (replace-match "\\2 (\\1\\3)" nil nil))
                               (buffer-string)))
                       (cons choice file))
                     files))
        (setq chosen
              (cdr (assoc
                    (let ((completion-ignore-case t))
                      (completing-read "Choose man page: " table nil t))
                    table)))))
      (when chosen
        (if (fboundp 'woman-find-file)
            (woman-find-file chosen)
          (manual-entry chosen)))))))

(defun apt-utils-view-emacs-startup-file ()
  "View Emacs startup file for the current package.
If there is more than one file associated with the package, offer
a choice."
  (interactive)
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (message "Not in APT utils buffer."))
   ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))
    (message "Not a normal package."))
   (t
    (let ((package (caar apt-utils-package-history))
          chosen files table)
      (setq files
            (or (apt-utils-get-package-files package
                                             "^/etc/emacs/site-start.d/.*")
                (and (boundp 'debian-emacs-flavor)
                     (apt-utils-get-package-files
                      package
                      (format "^/etc/%s/site-start.d/.*"
                              (symbol-name debian-emacs-flavor))))))
      (cond
       ((null files)
        (message "No Emacs startup files found for %s." package))
       ((not (cdr files))
        (setq chosen (car files)))
       (t
        (setq table (mapcar
                     (lambda (file)
                       (cons file file))
                     files))
        (setq chosen
              (cdr (assoc
                    (let ((completion-ignore-case t))
                      (completing-read "Choose Emacs startup file: " table nil t))
                    table)))))
      (when chosen
        (apt-utils-view-file chosen))))))

(defun apt-utils-view-version ()
  "View installed version information for current package."
  (interactive)
  (let ((package (caar apt-utils-package-history))
        (type (cdar apt-utils-package-history)))
    (if (memq type '(normal normal-showpkg normal-installed))
        (let ((info (apt-utils-get-installed-info package)))
          (if info
              (message (apply #'format
                              "%s: version %s (Desired = %s; Status = %s; Error = %s)"
                              package info))
            (message "Not installed; not known to dkpg")))
      (message "Can show version info only for normal packages"))))

(defun apt-utils-get-installed-info (package)
  "Return list of installation information for package PACKAGE."
  (let ((desired-list '((?u "Unknown")
                        (?i "Install")
                        (?r "Remove")
                        (?p "Purge")
                        (?h "Hold")))
        (status-list '((?n "Not installed")
                       (?i "Installed")
                       (?c "Config files")
                       (?u "Unpackage")
                       (?f "Failed config")
                       (?h "Half installed")))
        (err-list '((?  "None")
                    (?h "Hold")
                    (?r "Reinstall required")
                    (?x "Hold + reinstall required")))
        desired status err status-bad err-bad)
    (unless (eq package 'broken)
      (with-temp-buffer
        (let ((process-environment (append '("COLUMNS=200") (copy-alist process-environment))))
          (call-process apt-utils-dpkg-program nil t nil "-l" package))
        (when (re-search-backward
               (format "^\\([a-z ][a-z ][a-z ]\\)\\s-+%s\\s-+\\(\\S-+\\)"
                       (regexp-quote package)) nil t)
          (progn
            (setq desired (aref (match-string 1) 0)
                  status (aref (match-string 1) 1)
                  err (aref (match-string 1) 2)
                  status-bad (not (eq status (downcase status)))
                  err-bad (not (eq err (downcase err))))
            ;; Return list of information
            (list (match-string 2)      ; version
                  (cadr (assoc desired desired-list))
                  (concat (cadr (assoc (downcase status) status-list))
                          (and status-bad " [bad]"))
                  (concat (cadr (assoc (downcase err) err-list))
                          (and err-bad " [bad]")))))))))

(defun apt-utils-insert-installed-info (package)
  "Insert installed information for package PACKAGE at point."
  (let ((posn (point)))
    (insert (format " (%s)" (or (nth 2 (apt-utils-get-installed-info package))
                                "Not installed; not known to dpkg")))
    (add-text-properties (1+ posn)
                         (point)
                         '(face apt-utils-installed-status-face))))

;; File-related utility functions

(defun apt-utils-find-readable-file (dir prefixes suffixes)
  "Find a readable file composed of directory prefix and suffix.
Directory is DIR, prefix is one of PREFIXES and suffix is one of
SUFFIXES."
  (catch 'found
    (dolist (prefix prefixes)
      (dolist (suffix suffixes)
        (when (file-readable-p (concat dir prefix suffix))
          (throw 'found (concat dir prefix suffix)))))
    nil))                               ; Return nil, if no file found

(defun apt-utils-view-file (file)
  "View file FILE in function `view-mode'."
  (cond ((string-match "\\.gz$" file)
         (if (fboundp 'with-auto-compression-mode)
             (with-auto-compression-mode
               (view-file file))
           (auto-compression-mode 1)
           (view-file file)))
        (t
         (view-file file))))

;; Follow hyperlinks

(defun apt-utils-follow-link (new-session)
  "Follow hyperlink at point.
With non-nil NEW-SESSION, follow link in a new buffer."
  (interactive "P")
  (unless (equal major-mode 'apt-utils-mode)
    (error "Not in APT utils buffer"))
  (let ((package
         (cadr
          (member 'apt-package (text-properties-at (point))))))
    (apt-utils-follow-link-internal package new-session)))

(defun apt-utils-mouse-follow-link (event)
  "Follow hyperlink at mouse click.
Argument EVENT is a mouse event."
  (interactive "e")
  (let (package)
    (save-selected-window
      (mouse-set-point event)
      (setq package (apt-utils-package-at-point))
      (apt-utils-follow-link-internal package nil))))

(defun apt-utils-package-at-point ()
  "Return name of package at point, if any."
  (cadr
   (member 'apt-package (text-properties-at
                         (point)))))

(defun apt-utils-follow-link-internal (package new-session)
  "Follow hyperlink for PACKAGE.
With non-nil NEW-SESSION, follow link in a new buffer."
  (cond
   ((equal package 'broken)
    (message "Package name is broken somehow."))
   (package
    (unless new-session
      (apt-utils-update-buffer-positions 'forward))
    (apt-utils-show-package-1 package nil new-session)
    (unless new-session
      (setq apt-utils-package-history
            (cons (cons package (apt-utils-package-type package))
                  apt-utils-package-history))))
   (t
    (message "No known package at point."))))

;; Go to previous package in list

(defun apt-utils-view-previous-package ()
  "Go back to previous package displayed."
  (interactive)
  (unless (equal major-mode 'apt-utils-mode)
    (error "Not in APT utils buffer"))
  (if (cdr apt-utils-package-history)
      (progn
        (let ((posns (apt-utils-update-buffer-positions 'backward)))
          (apt-utils-show-package-1 (cadr apt-utils-package-history) nil)
          (goto-char (car posns))
          (set-window-start (selected-window) (cadr posns)))
        (setq apt-utils-package-history (cdr apt-utils-package-history)))
    (message "No further package history.")))

(defun apt-utils-previous-package-p ()
  "Return non-nil if there is a previous entry in the package history.
See also `apt-utils-package-history'."
  (cdr apt-utils-package-history))

;; Adapted from widget-move

(defun apt-utils-next-package (&optional arg)
  "Move point to the ARG next package.
ARG may be negative to move backward."
  (interactive "p")
  (unless (equal major-mode 'apt-utils-mode)
    (error "Not in APT utils buffer"))
  (cond
   ;; No links
   ((or (null apt-utils-current-links)
        (= (hash-table-count apt-utils-current-links) 0))
    (message "No package links."))
   ;; One link
   ((and (= (hash-table-count apt-utils-current-links) 1)
         (not (eq (cdar apt-utils-package-history) 'search-file-names)))
    (goto-char (point-min))
    (goto-char (next-single-property-change (point)
                                                 'apt-package)))
   (t
    (let ((old (apt-utils-package-at)))
      ;; Forward.
      (while (> arg 0)
        (cond ((eobp)
               (goto-char (point-min)))
              (t
               (goto-char (or (next-single-property-change
                               (point) 'apt-package)
                              (point-max)))))
        (let ((new (apt-utils-package-at)))
          (when new
            (unless (eq new old)
              (setq arg (1- arg))
              (setq old new)))))
      ;; Backward.
      (while (< arg 0)
        (cond ((bobp)
               (goto-char (point-max)))
              (t
               (goto-char (or (previous-single-property-change
                               (point) 'apt-package)
                              (point-min)))))
        (let ((new (apt-utils-package-at)))
          (when new
            (unless (eq new old)
              (setq arg (1+ arg))))))
      ;; Go to beginning of field.
      (let ((new (apt-utils-package-at)))
        (while (eq (apt-utils-package-at) new)
          (backward-char)))
      (forward-char))))
  ;; Echo some info
  (when apt-utils-show-link-info
    (apt-utils-package-at-message)))

(defun apt-utils-previous-package (&optional arg)
  "Move point to the ARG previous package.
ARG may be negative to move forward."
  (interactive "p")
  (apt-utils-next-package (- arg)))

;; Choose a package from the known links

(defun apt-utils-choose-package-link (new-session)
  "Choose a Debian package from a list of links.
With non-nil NEW-SESSION, follow link in a new buffer."
  (interactive "P")
  (apt-utils-choose-package-link-internal new-session))

(defun apt-utils-choose-package-link-internal (new-session)
  "Choose a Debian package from a list of links.
With non-nil NEW-SESSION, follow link in a new buffer."
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (error "Not in APT utils buffer"))
   ((= (hash-table-count apt-utils-current-links) 0)
    (message "No package links."))
   (t
    (let* ((PC-word-delimiters "-")
           (package
            (completing-read "Choose related Debian package: "
                             (cond
                              (apt-utils-completing-read-hashtable-p
                               apt-utils-current-links)
                              (t
                               (apt-utils-build-completion-table
                                apt-utils-current-links)))
                             nil t)))
      (when (> (length package) 0)
        (unless new-session
          (apt-utils-update-buffer-positions 'forward))
        (apt-utils-show-package-1 package nil new-session)
        (unless new-session
          (setq apt-utils-package-history
                (cons (cons package (apt-utils-package-type package))
                      apt-utils-package-history))))))))

(defun apt-utils-build-package-list (&optional force)
  "Build list of Debian packages known to APT.
With optional argument FORCE, rebuild the packages lists even if
they are defined.  When package lists are not up-to-date, this is
indicated in `mode-name'."
  (when (or force (null apt-utils-package-list-built))
    (unwind-protect
        (progn
          (setq apt-utils-package-list-built nil
                apt-utils-automatic-update-asked nil)
          (message "Building Debian package lists...")
          ;; Hash table listing package types
          (if (hash-table-p apt-utils-package-list)
              (clrhash apt-utils-package-list)
            (setq apt-utils-package-list (make-hash-table :test 'equal)))
          ;; All packages except virtual ones
          (with-temp-buffer
            ;; Virtual and normal packages
            (call-process apt-utils-apt-cache-program nil '(t nil) nil "pkgnames")
            (goto-char (point-min))
            (while (not (eobp))
              (apt-utils-puthash (buffer-substring (apt-utils-line-beginning-position)
                                                   (apt-utils-line-end-position))
                                 'virtual apt-utils-package-list)
              (forward-line 1))
            ;; Normal packages
            (erase-buffer)
            (call-process apt-utils-apt-cache-program nil '(t nil) nil "pkgnames"
                          "-o" "APT::Cache::AllNames=0")
            (goto-char (point-min))
            (while (not (eobp))
              (apt-utils-puthash (buffer-substring (apt-utils-line-beginning-position)
                                                   (apt-utils-line-end-position))
                                 'normal apt-utils-package-list)
              (forward-line 1))
            ;; Installed packages
            (erase-buffer)
            (call-process apt-utils-dpkg-program nil t nil "-l")
            (goto-char (point-min))
            (let (package)
              (while (not (eobp))
                (when (looking-at "^ii")
                  (setq package
                        (nth 1 (split-string (buffer-substring
                                              (apt-utils-line-beginning-position)
                                              (apt-utils-line-end-position))
                                             "\\s-+")))
                  (apt-utils-puthash package
                                     'normal-installed
                                     apt-utils-package-list))
                (forward-line 1))))
          (message "Building Debian package lists...done.")
          (setq apt-utils-package-list-built (current-time))
          (apt-utils-update-mode-name))
      (unless apt-utils-package-list-built
        (message "Building Debian package lists...interrupted.")
        (apt-utils-update-mode-name)
        (if (hash-table-p apt-utils-package-list)
            (clrhash apt-utils-package-list))))))

(defun apt-utils-rebuild-package-lists ()
  "Rebuild the APT package lists."
  (interactive)
  (apt-utils-build-package-list t))

(defun apt-utils-choose-package ()
  "Choose a Debian package name."
  (let ((package
         (and (eq major-mode 'apt-utils-mode)
              (cadr (member 'apt-package
                            (text-properties-at (point))))))
        (PC-word-delimiters "-"))
    (when (not (stringp package))
      (setq package nil))
    (completing-read (if package
                         (format "Choose Debian package (%s): " package)
                       "Choose Debian package: ")
                     'apt-utils-choose-package-completion
                     nil t package)))

;; emacs 22 has `dynamic-completion-table' to help construct a
;; function like this, but emacs 21 and xemacs 21) don't
(defun apt-utils-choose-package-completion (str pred all)
  "Apt package name completion handler, for `completing-read'."
  (let ((enable-recursive-minibuffers t))
    (apt-utils-check-package-lists))
  (cond ((null all)
         (try-completion str (if apt-utils-completing-read-hashtable-p
                                 apt-utils-package-list
                               (apt-utils-build-completion-table
                                apt-utils-package-list))
                         pred))
        ((eq all t)
         (all-completions str (if apt-utils-completing-read-hashtable-p
                                  apt-utils-package-list
                                (apt-utils-build-completion-table
                                 apt-utils-package-list))
                          pred))
        ((eq all 'lambda)
         (if (fboundp 'test-completion)
             ;; `test-completion' is new in emacs22, and it takes
             ;; hashtables, so don't really need to test
             ;; apt-utils-completing-read-hashtable-p
             (test-completion str (if apt-utils-completing-read-hashtable-p
                                      apt-utils-package-list
                                    (apt-utils-build-completion-table
                                     apt-utils-package-list))
                              pred)
           (and (gethash str apt-utils-package-list)
                t)))))

(defun apt-utils-build-completion-table (hash)
  "Build completion table for packages using keys of hashtable HASH."
  (let (ret)
    (maphash (lambda (key value)
               (setq ret (cons (list key) ret)))
             hash)
    ret))

;; Add hyperlinks

(defun apt-utils-add-package-links ()
  "Add hyperlinks to related Debian packages."
  (let ((keywords '("Conflicts" "Depends" "Enhances" "Package"
                    "Pre-Depends" "Provides" "Recommends" "Replaces"
                    "Suggests"))
        match)
    (if (hash-table-p apt-utils-current-links)
        (clrhash apt-utils-current-links)
      (setq apt-utils-current-links (make-hash-table :test 'equal)))
    (goto-char (point-min))
    (while (re-search-forward "^\\([^ \n:]+\\):\\( \\|$\\)"
                              (point-max) t)
      (setq match (match-string 1))
      (add-text-properties (if (looking-at "$")
                               (point) ;; Conffiles (also see below)
                             (1- (point)))
                           (save-excursion
                             (beginning-of-line)
                             (point))
                           `(,apt-utils-face-property apt-utils-field-keyword-face))
      (cond
       ((member match keywords)
        ;; Remove newline characters in field
        (let ((end (apt-field-end-position)))
          (subst-char-in-region (point) end ?\n ?\  )
          (canonically-space-region (point) end))
        ;; Find packages
        (let ((packages (apt-utils-current-field-packages))
              (inhibit-read-only t)
              face
              length length-no-version
              package)
          (while packages
            (setq package (car packages))
            (setq length (length package))
            ;; Remove version info (in parenthesis), and whitespace
            (setq package (apt-utils-replace-regexp-in-string
                           "\\((.*)\\|\\s-+\\)" "" package))
            (setq length-no-version (length package))
            ;; Package type
            (cond
             ((equal (apt-utils-package-type package t) 'normal)
              (setq face 'apt-utils-normal-package-face))
             ((equal (apt-utils-package-type package t) 'normal-installed)
              (setq face 'apt-utils-normal-installed-package-face))
             ((equal (apt-utils-package-type package t) 'virtual)
              (setq face 'apt-utils-virtual-package-face))
             (t
              (setq face 'apt-utils-broken-face)
              (setq package 'broken)))
            ;; Store package links
            (apt-utils-current-links-add-package package)
            ;; Add text properties
            (add-text-properties (point) (+ (point) length-no-version)
                                 `(,apt-utils-face-property ,face
                                        mouse-face highlight
                                        apt-package ,package))
            ;; Version?
            (when (> length length-no-version)
              (add-text-properties (+ (point) length-no-version 1)
                                   (+ (point) length)
                                   `(,apt-utils-face-property apt-utils-version-face)))
            ;; Fill package names
            (when (and apt-utils-fill-packages
                       (> (current-column) (+ 2 (length match)))
                       (> (+ (current-column) length) fill-column))
              (when (equal (char-before) ?\ )
                (delete-char -1))          ; trailing whitespace
              (insert "\n" (make-string (+ 2 (length match)) ? )))
            (forward-char length)
            (when (and (equal match "Package")
                       apt-utils-display-installed-status)
              (apt-utils-insert-installed-info package))
            (skip-chars-forward ", |\n")
            (setq packages (cdr packages)))))
       ((string-match-p "Description\\(-..\\)?" match)
        (add-text-properties (point)
                             (save-excursion
                               (or
                                (re-search-forward "^[^ ]" (point-max) t)
                                (point-max)))
                             `(,apt-utils-face-property apt-utils-description-face)))
       ;; Conffiles doesn't have trailing space
       ((looking-at "$")
        nil)
       (t
        (add-text-properties (1- (point))
                             (save-excursion
                               (end-of-line)
                               (point))
                             `(,apt-utils-face-property apt-utils-field-contents-face)))))))

(defun apt-utils-add-showpkg-links (package)
  "Add hyperlinks to related Debian packages for PACKAGE."
  (let ((keywords '("Reverse Depends" "Reverse Provides"))
        (inhibit-read-only t)
        start end regexp face link)
    (if (hash-table-p apt-utils-current-links)
        (clrhash apt-utils-current-links)
      (setq apt-utils-current-links (make-hash-table :test 'equal)))
    (while keywords
      (setq regexp (concat "^" (car keywords) ": "))
      (goto-char (point-min))
      (when (re-search-forward regexp (point-max) t)
        (add-text-properties (match-beginning 0) (1- (match-end 0))
                             `(,apt-utils-face-property
                               apt-utils-field-keyword-face))
        ;; Limits of search
        (setq start (1+ (point)))
        (setq end (or (re-search-forward "[a-z]:" (point-max) t)
                      (point-max)))
        (save-restriction
          (narrow-to-region start end)
          (goto-char (point-min))
          (while (not (eobp))
            (when (or (looking-at "^\\s-+\\(.*\\),")
                      (looking-at "^\\(.*\\) "))
              (setq link (match-string 1))
              (cond
               ((equal (apt-utils-package-type link t) 'normal)
                (setq face 'apt-utils-normal-package-face))
               ((equal (apt-utils-package-type package t) 'normal-installed)
                (setq face 'apt-utils-normal-installed-package-face))
               ((equal (apt-utils-package-type link t) 'virtual)
                (setq face 'apt-utils-virtual-package-face))
               (t
                (setq face 'apt-utils-broken-face)
                (setq link 'broken)))
              ;; Store package links
              (apt-utils-current-links-add-package link)
              (add-text-properties (match-beginning 1) (match-end 1)
                                   `(,apt-utils-face-property ,face
                                          mouse-face highlight
                                          apt-package ,link)))
          (forward-line))))
      (setq keywords (cdr keywords))))
  (when (and apt-utils-display-installed-status
             (memq (apt-utils-package-type package t)
                   '(normal normal-installed)))
    (goto-char (point-min))
    (re-search-forward "Package: .*$")
    (apt-utils-insert-installed-info package)))

(defun apt-utils-add-search-links (type)
  "Add hyperlinks to related Debian packages.
The type of search is specified by TYPE."
  (let ((inhibit-read-only t)
        local-keymap
        face link regexp)
    (when (eq type 'search-file-names)
      (setq local-keymap (make-sparse-keymap))
      (define-key local-keymap (kbd "RET")
        (lambda ()
          (interactive)
          (view-file (or (get-text-property (point) 'apt-package-file)
                         (get-text-property (1- (point)) 'apt-package-file))))))
    (if (hash-table-p apt-utils-current-links)
        (clrhash apt-utils-current-links)
      (setq apt-utils-current-links (make-hash-table :test 'equal)))
    (goto-char (point-min))
    (forward-line 2)                    ; Move past header
    (cond
     ((eq type 'search-file-names)
      ;; Reformat diversion information
      (save-excursion
        (while (re-search-forward "diversion by \\(.*\\) \\(from\\|to\\): \\(.*\\)" nil t)
          (replace-match "\\1: \\3 (diversion \\2)" nil nil)))
      (setq regexp "\\([^:,]+\\)[,:]"))
     (t
      (setq regexp"^\\([^ ]+\\) - ")))
    (while (re-search-forward regexp (point-max) t)
      (setq link (match-string 1))
      (cond
       ((equal (apt-utils-package-type link t) 'normal)
        (setq face 'apt-utils-normal-package-face))
       ((equal (apt-utils-package-type link t) 'normal-installed)
        (setq face 'apt-utils-normal-installed-package-face))
       ((equal (apt-utils-package-type link t) 'virtual)
        (setq face 'apt-utils-virtual-package-face))
       (t
        (setq face 'apt-utils-broken-face)
        (setq link 'broken)))
      ;; Store package links
      (apt-utils-current-links-add-package link)
      (add-text-properties (match-beginning 1) (match-end 1)
                           `(,apt-utils-face-property ,face
                                  mouse-face highlight
                                  apt-package ,link))
      ;; Multiple fields separated by commas
      (when (eq type 'search-file-names)
        (if (eq (char-before) ?\:)
            (progn
              (when local-keymap
                (let ((start (1+ (point)))
                      (end (save-excursion
                             (goto-char (apt-utils-line-end-position))
                             (re-search-backward " (diversion \\(from\\|to\\))"
                                                 (apt-utils-line-beginning-position)
                                                 t)
                             (point))))
                  (add-text-properties start end
                                       `(face apt-utils-file-face
                                              keymap ,local-keymap
                                              ;; Pretend we're a package
                                              ;; so that we can move
                                              ;; here with
                                              ;; apt-utils-next-package
                                              apt-package dummy
                                              apt-package-file
                                              ,(buffer-substring-no-properties start end)
                                              ))))
              (goto-char (1+ (apt-utils-line-end-position))))
          (skip-chars-forward ", "))))))

(defun apt-utils-package-type (package &optional no-error)
  "Return what type of package PACKAGE is.
With optional argument NO-ERROR, don't flag an error for unknown
packages."
  (or (gethash package apt-utils-package-list)
      (cond
       (no-error
        nil)
       (t
        (error
         (substitute-command-keys
          "Package name is broken: rebuild package lists using \\[apt-utils-rebuild-package-lists] may help")
         package)))))

(defun apt-utils-package-at ()
  "Get package at point."
  (get-text-property (point) 'apt-package))

(defun apt-utils-package-at-message ()
  "Emit message describing package at point."
  (let ((package (apt-utils-package-at)))
    (cond
     ((eq package 'dummy)
      ;; Do nothing as this isn't really a package
      )
     ((equal package 'broken)
      (message "Package name is broken somehow."))
     (package
      (with-temp-buffer
        (call-process apt-utils-apt-cache-program nil t nil "show" package)
        (if (re-search-backward "^Description: \\(.*\\)$" (point-min) t)
            (message "%s: %s." package (match-string 1))
          (message "%s: virtual package (no description)."
                   package)))))))

(defun apt-utils-quit (&optional kill-buffer)
  "Quit this `apt-utils-mode' buffer.
With prefix argument KILL-BUFFER, kill the `apt-utils-mode'
buffer."
  (interactive "P")
  (unless (equal major-mode 'apt-utils-mode)
    (error "Not in APT utils buffer"))
  (let ((buffer (current-buffer)))
    (if (fboundp 'quit-window)
        (quit-window)
      (bury-buffer))
    (when kill-buffer
      (kill-buffer buffer)))
  (run-hooks 'apt-utils-quit-hooks))

(defun apt-utils-cleanup ()
  "Clean up lists used by `apt-utils-mode'.
Specifically, nullify `apt-utils-package-list'.  Only do this if
there are no buffers left in `apt-utils-mode'."
  (unless (memq 'apt-utils-mode
                (mapcar (lambda (b)
                          (with-current-buffer b
                            major-mode))
                        (delete (current-buffer) (buffer-list))))
    (clrhash apt-utils-package-list)
    (setq apt-utils-package-list-built nil)))

(defun apt-utils-describe-package ()
  "Describe package at point."
  (interactive)
  (apt-utils-package-at-message))

(defun apt-utils-kill-other-window-buffers ()
  "Kill buffers in other windows and the windows themselves.
See `apt-utils-kill-buffer-confirmation-function' for
customisation options."
  (interactive)
  (cond
   ((not (eq major-mode 'apt-utils-mode))
    (error "Not in APT utils buffer"))
   ((not (cdr (window-list)))
    (message "No other windows to kill"))
   (t
    (when (or (null apt-utils-kill-buffer-confirmation-function)
              (funcall apt-utils-kill-buffer-confirmation-function
                       "Kill buffers in other windows? "))
      (let ((buffer-list
             (delq (current-buffer)
                   (mapcar #'window-buffer (window-list)))))
        (mapc (lambda (b)
                (when (buffer-live-p b)
                  (kill-buffer b)))
              buffer-list))
      (delete-other-windows))
    (message nil))))

;; Track positions

(defun apt-utils-update-buffer-positions (type)
  "Update `apt-utils-buffer-positions'.
TYPE can be forward, backward, or toggle."
  (let (posns)
    (cond
     ((eq type 'forward)
      ;; Make the key unique; we could visit the same package more
      ;; than once
      (apt-utils-puthash (format "%s/%s/%d"
                       (caar apt-utils-package-history)
                       (cdar apt-utils-package-history)
                       (length apt-utils-package-history))
               (list (point) (window-start (selected-window)))
               apt-utils-buffer-positions))
     ((eq type 'backward)
      ;; Remove old values
      (remhash (format "%s/normal/%d"
                       (caar apt-utils-package-history)
                       (length apt-utils-package-history))
               apt-utils-buffer-positions)
      (remhash (format "%s/normal-showpkg/%d"
                       (caar apt-utils-package-history)
                       (length apt-utils-package-history))
               apt-utils-buffer-positions)
      (remhash (format "%s/virtual/%d"
                       (caar apt-utils-package-history)
                       (length apt-utils-package-history))
               apt-utils-buffer-positions)
      ;; Get position for previous package
      (setq posns
            (gethash (format "%s/%s/%d"
                             (car (cadr apt-utils-package-history))
                             (cdr (cadr apt-utils-package-history))
                             (1- (length apt-utils-package-history)))
                     apt-utils-buffer-positions)))
     ((eq type 'toggle)
      ;; new/old package types
      (let ((package (caar apt-utils-package-history))
            (type (cdar apt-utils-package-history))
            new old)
        (if (equal type 'normal)
            (setq old 'normal
                  new 'normal-showpkg)
          (setq old 'normal-showpkg
                new 'normal))
        ;; Set position for old entry
        (apt-utils-puthash (format "%s/%s/%d"
                         package
                         old
                         (length apt-utils-package-history))
                 (list (point) (window-start (selected-window)))
                 apt-utils-buffer-positions)
        ;; Get position for new entry
        (setq posns
              (gethash (format "%s/%s/%d"
                               package
                               new
                               (length apt-utils-package-history))
                       apt-utils-buffer-positions
                       (list 1 1)))     ; default value
        )))
    posns))

(defun apt-utils-current-field-packages ()
  "Return a list of the packages on the current line."
  (let ((keywords '("Conflicts" "Depends" "Enhances" "Package"
                    "Pre-Depends" "Provides" "Recommends" "Replaces"
                    "Suggests"))
        eol match packages posn string)
    (save-excursion
      (end-of-line)
      (setq eol (point))
      (beginning-of-line)
      (cond
       ((eobp)
        (message "Not on package field line.")
        nil)
       ((and (re-search-forward "^\\([^ \n:]+\\): " eol t)
             (setq match (match-string 1))
             (member match keywords))
        (setq posn (point))
        (goto-char (apt-field-end-position))
        (setq string (buffer-substring-no-properties posn (point)))
        (with-temp-buffer
          (insert string)
          (goto-char (point-min))
          (while (re-search-forward "\n *" nil t)
            (replace-match " "))
          (setq packages
                ;; Packages split by commas, or alternatives by vertical
                ;; bars; for Enhances, multiple lines my be spanned
                (split-string (buffer-substring (point-min) (point-max))
                              " ?[,|] ?")))
        packages)
       (t
        (message "Not on package field line.")
        nil)))))

(defun apt-field-end-position ()
  "Move to end of current field."
  (save-excursion
    (re-search-forward "\\(^[^: ]+:\\|^$\\)")
    (beginning-of-line)
    (backward-char)
    (point)))

;; Borrowed from gnus/lisp/time-date.el

(defun apt-utils-time-less-p (t1 t2)
  "Say whether time value T1 is less than time value T2."
  (or (< (car t1) (car t2))
      (and (= (car t1) (car t2))
           (< (nth 1 t1) (nth 1 t2)))))

(defun apt-utils-web-browse-debian-changelog ()
  "Browse web version of Debian ChangeLog file for the current package."
  (interactive)
  (apt-utils-web-browse-url
   apt-utils-web-browse-debian-changelog-url))

(defun apt-utils-web-browse-bug-reports ()
  "Browse Debian bug reports for the current package."
  (interactive)
  (apt-utils-web-browse-url
   apt-utils-web-browse-bug-reports-url))

(defun apt-utils-web-browse-copyright ()
  "Browse web version of Debian copyright file for the current package."
  (interactive)
  (apt-utils-web-browse-url
   apt-utils-web-browse-copyright-url))

(defun apt-utils-web-browse-versions ()
  "Browse web version information for the current package."
  (interactive)
  (apt-utils-web-browse-url
   apt-utils-web-browse-versions-url))

(defun apt-utils-web-browse-url (url)
  "Browse Debian-related URL.
The URL can contain tokens that need formatting (see
`apt-utils-web-format-url')."
  (cond
   ((not (equal major-mode 'apt-utils-mode))
    (message "Not in APT utils buffer."))
   ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed)))
    (message "Not a normal package."))
   (t
    (browse-url (apt-utils-web-format-url url)))))

(defun apt-utils-web-format-url (url)
  "Format and return Debian URL.
The tokens that can be replaced are:
    %d: pool directory
    %s: source package name
    %p: package name
    %v: package version."
  (let ((buffer (current-buffer))
        (package (caar apt-utils-package-history))
        (type (cdar apt-utils-package-history))
        char source-package version)
    (save-excursion                     ; for normal package type
      (with-temp-buffer
        (cond
         ((memq type '(normal normal-installed))
          (set-buffer buffer))
         ((eq type 'normal-showpkg)
          (call-process apt-utils-apt-cache-program nil '(t nil) nil "show" package)))
        (goto-char (point-min))
        (if (re-search-forward "^Source: \\(.*\\)$" (point-max) t)
            (setq source-package (match-string 1))
          (setq source-package package))
        (goto-char (point-min))
        (re-search-forward "^Version: \\([0-9]:\\)?\\(.*\\)$" (point-max))
        (setq version (match-string 2))))
    ;; Format the URL
    (while (string-match "%\\(.\\)" url)
      (setq char (string-to-char (match-string 1 url)))
      (setq url (apt-utils-replace-regexp-in-string
                 (match-string 0 url)
                 (cond
                  ((eq char ?d)
                   (substring source-package 0
                              (if (string-match "^lib[a-z]"
                                                source-package)
                                  4 1)))
                  ((eq char ?s) source-package)
                  ((eq char ?p) package)
                  ((eq char ?v) version)
                  (t
                   (error "Unrecognized token (%%%c) in URL: %s" char url)))
                 url))))
  url)

(defun apt-utils-packages-needs-update ()
  "Return t if `apt-utils' package lists needs updating."
  (or (not apt-utils-package-list-built)
      (apt-utils-time-less-p apt-utils-package-list-built
                             (nth 5 (file-attributes apt-utils-timestamped-file)))))

(defun apt-utils-update-mode-name ()
  "Update `mode-name' for all buffers in `apt-utils-mode'."
  (let* ((need-update (apt-utils-packages-needs-update))
         (update-string
          (and need-update
               (substitute-command-keys
                ": update using \\\\[apt-utils-rebuild-package-lists]")))
         (name (concat "APT utils" update-string)))
    (mapc (lambda (b)
            (with-current-buffer b
              (when (eq major-mode 'apt-utils-mode)
                (setq mode-name name))))
          (buffer-list))))

(defun apt-utils-current-links-add-package (package)
  "Add PACKAGE to `apt-utils-current-links' hashtable."
  (unless (eq package 'broken)
    (apt-utils-puthash package nil apt-utils-current-links)))

;; Mode settings

(defvar apt-utils-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "#")             'apt-utils-rebuild-package-lists)
    (define-key map (kbd "1")             'delete-other-windows)
    (define-key map (kbd "<")             'apt-utils-view-previous-package)
    (define-key map (kbd ">")             'apt-utils-choose-package-link)
    (define-key map (kbd "?")             'describe-mode)
    (define-key map (kbd "DEL")           'scroll-down)
    (define-key map (kbd "M-TAB")         'apt-utils-previous-package)
    (define-key map (kbd "RET")           'apt-utils-follow-link)
    (define-key map (kbd "S s")           'apt-utils-search)
    (define-key map (kbd "S f")           'apt-utils-search-file-names)
    (define-key map (kbd "S g")           'apt-utils-search-grep-dctrl)
    (define-key map (kbd "S n")           'apt-utils-search-names-only)
    (define-key map (kbd "SPC")           'scroll-up)
    (define-key map (kbd "TAB")           'apt-utils-next-package)
    (define-key map (kbd "b C")           'apt-utils-web-browse-debian-changelog)
    (define-key map (kbd "b b")           'apt-utils-web-browse-bug-reports)
    (define-key map (kbd "b l")           'apt-utils-web-browse-copyright)
    (define-key map (kbd "b v")           'apt-utils-web-browse-versions)
    (define-key map (kbd "d")             'apt-utils-describe-package)
    (when (fboundp 'window-list)
      (define-key map (kbd "k")           'apt-utils-kill-other-window-buffers))
    (define-key map (kbd "l")             'apt-utils-list-package-files)
    (define-key map (kbd "o")             'other-window)
    (define-key map (kbd "q")             'apt-utils-quit)
    (define-key map (kbd "s")             'apt-utils-show-package)
    (define-key map (kbd "t")             'apt-utils-toggle-package-info)
    (define-key map (kbd "v C")           'apt-utils-view-debian-changelog)
    (define-key map (kbd "v R")           'apt-utils-view-debian-readme)
    (define-key map (kbd "v N")           'apt-utils-view-debian-news)
    (define-key map (kbd "v c")           'apt-utils-view-changelog)
    (define-key map (kbd "v e")           'apt-utils-view-emacs-startup-file)
    (define-key map (kbd "v f")           'apt-utils-view-package-files)
    (define-key map (kbd "v l")           'apt-utils-view-copyright)
    (define-key map (kbd "v m")           'apt-utils-view-man-page)
    (define-key map (kbd "v n")           'apt-utils-view-news)
    (define-key map (kbd "v r")           'apt-utils-view-readme)
    (define-key map (kbd "v v")           'apt-utils-view-version)
    (define-key map [(shift iso-lefttab)] 'apt-utils-previous-package)
    (define-key map [(shift tab)]         'apt-utils-previous-package)
    (define-key map
      (if apt-utils-xemacs-p '(button2) (kbd ""))
      'apt-utils-mouse-follow-link)
    map)
  "Keymap for apt-utils mode.")

;; Menus

(defvar apt-utils-menu nil
  "Menu to use for `apt-utils-mode'.")

(when (fboundp 'easy-menu-define)

  (easy-menu-define apt-utils-menu apt-utils-mode-map "Apt Utils Menu"
    `("Apt Utils"
      ["Show Package"               apt-utils-show-package t]
      ["Toggle Package Info"        apt-utils-toggle-package-info
       (apt-utils-toggle-package-p)]
      ["View Previous Package"      apt-utils-view-previous-package
       (apt-utils-previous-package-p)]
      ["Choose Package Link"        apt-utils-choose-package-link
       (> (hash-table-count apt-utils-current-links) 0)]
      ["Next Package Link"          apt-utils-next-package
       (> (hash-table-count apt-utils-current-links) 0)]
      ["Previous Package Link"      apt-utils-previous-package
       (> (hash-table-count apt-utils-current-links) 0)]
      ["Follow Link at Point"       apt-utils-follow-link
       (apt-utils-package-at-point)]
      ["Rebuild Package Lists"      apt-utils-rebuild-package-lists t]
      "---"
      ("Search"
       ["Package Descriptions"      apt-utils-search t]
       ["Package Names"             apt-utils-search-names-only t]
       ["Installed Files"           apt-utils-search-file-names t]
       ["Grep-Dctrl"                apt-utils-search-grep-dctrl t])
      ("View Files"
       ,@(list (if apt-utils-xemacs-p
                   :included
                 :active)
               '(apt-utils-current-package-installed-p))
       ["ChangeLog"                 apt-utils-view-changelog
        (apt-utils-changelog-file)]
       ["Debian ChangeLog"          apt-utils-view-debian-changelog
        (apt-utils-debian-changelog-file)]
       ["README"                    apt-utils-view-readme
        (apt-utils-readme-file)]
       ["Debian README"             apt-utils-view-debian-readme
        (apt-utils-debian-readme-file)]
       ["NEWS"                      apt-utils-view-news
        (apt-utils-news-file)]
       ["Debian NEWS"               apt-utils-view-debian-news
        (apt-utils-debian-news-file)]
       ["Copyright"                 apt-utils-view-copyright
        (apt-utils-copyright-file)]
       "---"
       ["Man Page"                  apt-utils-view-man-page
        (apt-utils-current-package-installed-p)]
       "---"
       ["All Package Files (dired)" apt-utils-view-package-files
        (apt-utils-current-package-installed-p)])
      ("Browse URL"
       ,@(list (if apt-utils-xemacs-p
                   :included
                 :active)
               '(apt-utils-toggle-package-p))
       ["Debian ChangeLog"          apt-utils-web-browse-debian-changelog t]
       ["Bug Reports"               apt-utils-web-browse-bug-reports t]
       ["Copyright"                 apt-utils-web-browse-copyright t]
       ["Package Versions"          apt-utils-web-browse-versions t])
      "---"
      ["Help"                       describe-mode t]
      ["Quit"                       apt-utils-quit t])))

(defun apt-utils-mode ()
  "Major mode to interface Emacs with APT (Debian package management).

Start things off with, for example:

    M-x apt-utils-show-package RET emacs21 RET

Other packages (dependencies, conflicts etc.) can be navigated
using:

    \\[apt-utils-toggle-package-info] toggle package and showpkg information
    \\[apt-utils-view-previous-package] show the previous package from history
    \\[apt-utils-choose-package-link] choose next package from current links
    \\[apt-utils-next-package] move to next package link
    \\[apt-utils-previous-package] move to previous package link
    \\[apt-utils-follow-link] show package for the link at point
    \\[apt-utils-list-package-files] list package files (in a `dired' buffer)

Confirmation will be requested before updating the list of known
packages.  The update can be started at any time with
\\[apt-utils-rebuild-package-lists].

Package searches can be performed using:

    \\[apt-utils-search] search for regular expression in package names and descriptions
    \\[apt-utils-search-names-only] search for regular expression in package names
    \\[apt-utils-search-file-names] search for string in filenames
    \\[apt-utils-search-grep-dctrl] search for regular expression in selected package fields
    (using the grep-dctrl program)

Files associated with installed packages can be accessed using:

    \\[apt-utils-view-changelog] view ChangeLog file
    \\[apt-utils-view-debian-changelog] view Debian ChangeLog file
    \\[apt-utils-view-readme] view README file
    \\[apt-utils-view-debian-readme] view Debian README file
    \\[apt-utils-view-news] view NEWS file
    \\[apt-utils-view-debian-news] view Debian NEWS file
    \\[apt-utils-view-copyright] view copyright (licence) file
    \\[apt-utils-view-man-page] view man page

Web locations can be visited using:

    \\[apt-utils-web-browse-debian-changelog] browse Debian ChangeLog URL
    \\[apt-utils-web-browse-bug-reports] browse bug report URL
    \\[apt-utils-web-browse-copyright] browse copyright (licence) URL
    \\[apt-utils-web-browse-versions] browse package versions URL

A history of navigated packages is maintained when package links
are followed using `apt-utils-choose-package-link' or
`apt-utils-follow-link'.  This history is reset when
`apt-utils-show-package' or any of the search commands is used.

Key definitions:
\\{apt-utils-mode-map}"
  (kill-all-local-variables)
  (use-local-map apt-utils-mode-map)
  (setq major-mode 'apt-utils-mode)
  (setq mode-name "APT utils")
  (setq buffer-undo-list t)
  (setq truncate-lines t)
  ;; XEmacs
  (when (and (fboundp 'easy-menu-add)
             apt-utils-menu)
    (easy-menu-add apt-utils-menu))
  (add-hook 'kill-buffer-hook 'apt-utils-cleanup nil t)
  (run-hooks 'apt-utils-mode-hook))

;; Debugging

(defun apt-utils-trace-all ()
  "Trace all `apt-utils' functions.  For debugging."
  (require 'trace)
  (let ((buffer (get-buffer-create "*APT Utils Trace*")))
    (buffer-disable-undo buffer)
    (all-completions "apt-utils" obarray
                     (lambda (sym)
                       (and (fboundp sym)
                            (not (memq (car-safe (symbol-function sym))
                                       '(autoload macro)))
                            (trace-function-background sym buffer))))))

(defun apt-utils-sort-result ()
  (save-excursion
    (goto-char (point-min))
    (forward-line 2)
    (sort-lines nil (point) (point-max))))

(provide 'apt-utils)

;;; apt-utils.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/debian-el/debian-el.el0000775000000000000000000000647212230377265020124 0ustar  `;;; debian-el.el --- startup file for the debian-el package

;;; Commentary:
;; 
;; This file is loaded from /etc/emacs/site-start.d/50debian-el.el

;;; History:
;;
;; 2008-04-12 - Géraud Meyer
;;  - Use apt-sources-mode for files in /etc/apt/sources.list.d/ too.
;;  - Use \' instead of $ for the end of filenames.
;; 2003-09-01 - Peter Galbraith
;;  - Created.

;;; Code:

(defgroup debian-el nil
  "Debian debian-el package customization."
  :group 'convenience)

(require 'debian-el-loaddefs)
;;(require 'debian-el-custom)

;; apt-sources
(add-to-list 'auto-mode-alist '("sources\\.list\\'" . apt-sources-mode))
(add-to-list 'auto-mode-alist '("sources\\.list\\.d/.*\\.list\\'" . apt-sources-mode))
(defgroup apt-sources nil "Mode for editing apt sources.list files"
  :group 'tools
  :prefix "apt-sources-"
  :link '(custom-manual "(debian-el)apt-sources")
  :load 'apt-sources
;;:require 'apt-sources
  :group 'debian-el)
  
;; apt-utils
(defgroup apt-utils nil
  "Emacs interface to APT (Debian package management)"
  :group 'tools
  :link '(url-link "http://www.tc.bham.ac.uk/~matt/AptUtilsEl.html")
  :link '(custom-manual "(debian-el)apt-utils")
  :load 'apt-utils
;;:require 'apt-utils
  :group 'debian-el)

;; debian-bug.el
(defgroup debian-bug nil "Debian Bug report helper"
  :group 'tools
  :prefix "debian-bug-"
  :link '(custom-manual "(debian-el)debian-bug")
  :load 'debian-bug
;;:require 'debian-bug
  :group 'debian-el)

;; deb-view.el
(setq auto-mode-alist
      (append '(("\\.u?deb\\'" . deb-view-mode)) auto-mode-alist))
(defgroup deb-view nil
  "View Debian package files with tar-mode"
  :group 'tools
  :prefix "deb-view"
  :link '(custom-manual "(debian-el)deb-view")
  :load 'deb-view
  :group 'debian-el)
(add-hook
 'dired-load-hook
 (function (lambda ()
	     (define-key dired-mode-map "\C-d" 'deb-view-dired-view))))

(when (member 'utf-8 (coding-system-list))
  ;; The following from Kevin Ryde 
  ;; Closes: #484027
  (defun deb-view-control-coding (arg-list)
  "Return coding system for the \"control\" file in a deb.
This function is for use from `file-coding-system-alist'.

ARG-LIST is arguments passed to `find-operation-coding-system'.
The only operation handled here is `insert-file-contents' with a
buffer filename \".deb-INFO!./control\", for which the return is
'utf-8, and for anything else the return is nil (letting
`find-operation-coding-system' try other things).

This is done as a function because the filename passed to
find-operation-coding-system by tar-mode is merely the archive
member \"./control\".  By looking at the buffer-file-name we can
tell if it's from a deb.

Note: This only works in emacs22, in emacs21 or xemacs21 tar-mode
does something a bit different and doesn't reach here (and
there's no buffer passed to coding system functions)."
  (if (and (eq (car arg-list) 'insert-file-contents) ;; first arg
           (consp (cadr arg-list)) ;; second arg like ("./control" . BUFFER)
           (let ((buffer (cdr (cadr arg-list))))
             (and (buffer-file-name buffer)
                  (string-match "\\.deb-INFO!\\./control\\'"
                                (buffer-file-name buffer))
                  'utf-8)))
      'undecided))

  (add-to-list 'file-coding-system-alist
               '("\\'control\\'" . deb-view-control-coding)))

(provide 'debian-el)

;;; debian-el.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/devscripts-el/0000775000000000000000000000000012230377267016714 5ustar  emacs-goodies-el-35.8ubuntu2/elisp/devscripts-el/devscripts.el0000775000000000000000000001670712230377265021440 0ustar  ;; Routines to do devscripts-compatible emacs routines.
;; copyright 2002 Junichi Uekawa.

;; This file 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 2, or (at your option)
;; any later version.
;;
;; readme-debian.el 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 your Debian installation, in /usr/share/common-licenses/GPL
;; If not, write to the Free Software Foundation, 675 Mass Ave,
;; Cambridge, MA 02139, USA.

(require 'pbuilder-log-view-mode)
(require 'comint)

(defgroup devscripts nil "devscripts mode"
  :group 'tools
  :prefix "devscripts-")


(defcustom debuild-option-list '("-i" "-uc" "-us") "*Options to give to debuild."
  :type '(repeat string)
  :group 'devscripts)
(defconst devscripts-mode-version "$Id: devscripts.el,v 1.5 2007-07-13 15:13:30 dancer Exp $" "Version of devscripts mode.")

(defun devscripts-internal-get-debian-package-name ()
  "Find the directory with debian/ dir, and get the dir name."
  (let* ((looking-dir (expand-file-name (concat default-directory "."))))
    (while (not (file-accessible-directory-p (concat looking-dir "/debian")))
      (progn 
	(if (string= looking-dir "/")
	    (error "Cannot find debian dir anywhere"))
	(setq looking-dir (expand-file-name (expand-file-name (concat looking-dir "/.."))))))
    (file-name-nondirectory looking-dir)))

(defun debuild ()
  "Run debuild in the current directory."
  (interactive)
  (let* ((debuild-buffer (concat "*debuild*" default-directory))
	 (debuild-process (concat "debuild-process-" default-directory))
	 (package-name (devscripts-internal-get-debian-package-name)))
    (switch-to-buffer debuild-buffer)
    (toggle-read-only 0)
    (kill-region (point-min) (point-max))
    (compilation-mode)    
    (pbuilder-log-view-add package-name debuild-buffer (apply 'start-process debuild-process debuild-buffer "/usr/bin/debuild" debuild-option-list))))

(defun debi ()
  "Run debi in the current directory, to install debian packages generated by previous invocation of debuild."
  (interactive)
  (let* ((debi-name (concat "debi" default-directory))
	 (debi-buffer-name (concat "*" debi-name "*")))
    (make-comint debi-name devscripts-mode-gain-root-command
		 nil "/usr/bin/debi")
    (switch-to-buffer debi-buffer-name)))

(defun debit ()
  "Run debit in the current directory, to install debian packages generated by previous invocation of debuild."
  (interactive)
  (let* ((debit-buffer (concat "*debit*" default-directory))
	 (debit-process (concat "debit-process-" default-directory)))
    (switch-to-buffer debit-buffer)
    (kill-region (point-min) (point-max))
    (compilation-mode)
    (start-process debit-process debit-buffer devscripts-mode-gain-root-command "/usr/bin/debit")))


(defun debc ()
  "Run debc in the current directory, to install debian packages generated by previous invocation of debuild."
  (interactive)
  (let* ((debc-buffer (concat "*debc*" default-directory))
	 (debc-process (concat "debc-process-" default-directory)))
    (switch-to-buffer debc-buffer)
    (kill-region (point-min) (point-max))
    (devscripts-debc-mode)
    (start-process debc-process debc-buffer "/usr/bin/debc")))

(defun debclean ()
  "Run debclean in the current directory, to clean the debian build tree."
  (interactive)
  (let* ((debclean-buffer (concat "*debclean*" default-directory))
	 (debclean-process (concat "debclean-process-" default-directory)))
    (switch-to-buffer debclean-buffer)
    (kill-region (point-min) (point-max))
    (compilation-mode)
    (start-process debclean-process debclean-buffer "/usr/bin/debclean")))

(defun debdiff (changes-file-1 changes-file-2)
  "Compare contents of CHANGES-FILE-1 and CHANGES-FILE-2."
  (interactive "fFirst Changes file: \nfSecond Changes File: ")
  (let* ((debdiff-buffer (concat "*debdiff*" default-directory))
	 (debdiff-process (concat "debdiff-process-" default-directory)))
    (switch-to-buffer debdiff-buffer)
    (kill-region (point-min) (point-max))
    (start-process debdiff-process debdiff-buffer "/usr/bin/debdiff" 
		   (expand-file-name changes-file-1)
		   (expand-file-name changes-file-2))))

(defun debdiff-current ()
  "Compare the contents of .changes file of current version with previous version; 
requires access to debian/changelog, and being in debian/ dir."
  (interactive)
  (let* ((debdiff-buffer (concat "*debdiff*" default-directory))
	 (debdiff-process (concat "debdiff-process-" default-directory))
	 (debug-on-error t)
	 newversion oldversion pkgname changes-file-1 changes-file-2)
    (find-file "changelog")
    (save-excursion 
      (goto-char (point-min))
      (re-search-forward "^\\(\\S-+\\) +(\\([^:)]*:\\)?\\([^)]*\\))" nil t)
      (setq newversion (match-string 3))
      (setq pkgname (match-string 1))
      (re-search-forward "^\\(\\S-+\\) +(\\([^:)]*:\\)?\\([^)]*\\))" nil t)
      (setq oldversion (match-string 3)))
    (setq changes-file-1
	  (car (file-expand-wildcards (concat default-directory "../../" pkgname "_" oldversion "_*.changes"))))
    (setq changes-file-2
	  (car (file-expand-wildcards (concat default-directory "../../" pkgname "_" newversion "_*.changes"))))
    (princ pkgname)
    (princ oldversion)
    (princ changes-file-1)
    (princ changes-file-2)
    (switch-to-buffer debdiff-buffer)
    (kill-region (point-min) (point-max))
    (insert (concat 
	     "Comparing " 
	     (file-name-nondirectory changes-file-1) " and " 
	     (file-name-nondirectory changes-file-2)  "\n"))
    (start-process debdiff-process debdiff-buffer "/usr/bin/debdiff" 
		   (expand-file-name changes-file-1)
		   (expand-file-name changes-file-2))))

(defun devscripts-debc-mode ()
  "Mode to view debc output.
\\{devscripts-debc-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'devscripts-debc-mode)
  (setq mode-name "debc")
  (mapcar 'make-local-variable '(font-lock-defaults))
  (use-local-map devscripts-debc-mode-map)
  (set-syntax-table devscripts-debc-mode-syntax-table)
  (setq font-lock-defaults 
	'(
					;keywords start here
	  (("^[a-z].*deb$" . font-lock-string-face)
	   ("^ \\([A-Z][-A-Za-z]+:\\)\\(.*\\)$" (1 font-lock-keyword-face) (2 font-lock-warning-face))
	   ("^[^ ].*$" . font-lock-comment-face)
	   )
	  nil		;keywords-only
	  nil		;case-fold
	  ()		;syntax-alist
	  ))
  (run-hooks 'devscripts-debc-mode-hook)
)

(defvar devscripts-debc-mode-map nil "Keymap for devscripts debc mode.")
(defvar devscripts-debc-mode-syntax-table nil "Syntax table for devscripts debc mode.")
(if devscripts-debc-mode-syntax-table
         ()              ; Do not change the table if it is already set up.
       (setq devscripts-debc-mode-syntax-table (make-syntax-table))
       (modify-syntax-entry ?\" ".   " devscripts-debc-mode-syntax-table)
       (modify-syntax-entry ?\\ ".   " devscripts-debc-mode-syntax-table)
       (modify-syntax-entry ?' "w   " devscripts-debc-mode-syntax-table))
(defcustom devscripts-mode-gain-root-command "/usr/bin/sudo" "*The command used to gain root for running debi and debit."
  :group 'devscripts
  :type 'file)
(defcustom devscripts-mode-load-hook nil "*Hooks that are run when devscripts-mode is loaded."
  :group 'devscripts
  :type 'hook)
(run-hooks 'devscripts-mode-load-hook)
(provide 'devscripts)
emacs-goodies-el-35.8ubuntu2/elisp/devscripts-el/pbuilder-mode.el0000775000000000000000000001160712230377265021774 0ustar  ;; Routines to do devscripts-compatible emacs routines.
;; copyright 2002 Junichi Uekawa.

;; This file 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 2, or (at your option)
;; any later version.
;;
;; readme-debian.el 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 your Debian installation, in /usr/share/common-licenses/GPL
;; If not, write to the Free Software Foundation, 675 Mass Ave,
;; Cambridge, MA 02139, USA.

(require 'devscripts)
(require 'pbuilder-log-view-mode)

(defgroup pbuilder nil "PBuilder mode"
  :group 'tools
  :prefix "pbuilder-mode-")

(defcustom pbuilder-path "/usr/sbin/pbuilder" 
  "*Path to pbuilder."
  :group 'pbuilder
  :type 'file)
(defcustom pbuilder-user-mode-linux-path "/usr/bin/pbuilder-user-mode-linux" "*Path to pbuilder-user-mode-linux."
  :group 'pbuilder
  :type 'file)
(defcustom pdebuild-path "/usr/bin/pdebuild" "*Path to pdebuild."
  :group 'pbuilder
  :type 'file)
(defcustom pdebuild-user-mode-linux-path "/usr/bin/pdebuild-user-mode-linux" "*Path to pdebuild-user-mode-linux."
  :group 'pbuilder
  :type 'file)
(defcustom debuild-pbuilder-path "/usr/bin/debuild-pbuilder" "*Path to `debuild-pbuilder'."
  :group 'pbuilder
  :type 'file)
(defconst pbuilder-mode-version "$Id: pbuilder-mode.el,v 1.3 2007-07-14 09:26:05 dancer Exp $" "Version of pbuilder mode.")

(defun pdebuild ()
  "Run pdebuild in the current directory."
  (interactive)
  (let* ((pdebuild-buffer (concat "*pdebuild*" default-directory))
	 (pdebuild-process (concat "pdebuild-process-" default-directory))
	 (package-name (devscripts-internal-get-debian-package-name)))
    (switch-to-buffer pdebuild-buffer)
    (toggle-read-only 0)
    (kill-region (point-min) (point-max))
    (compilation-mode)
    (pbuilder-log-view-add
     package-name pdebuild-buffer
     (start-process pdebuild-process pdebuild-buffer pdebuild-path))))

(defun pdebuild-user-mode-linux ()
  "Run pdebuild-user-mode-linux in the current directory."
  (interactive)
  (let* ((pdebuild-buffer (concat "*pdebuild*" default-directory))
	 (pdebuild-process (concat "pdebuild-process-" default-directory))
	 (package-name (devscripts-internal-get-debian-package-name)))
    (switch-to-buffer pdebuild-buffer)
    (toggle-read-only 0)
    (kill-region (point-min) (point-max))
    (compilation-mode)
    (pbuilder-log-view-add
     package-name pdebuild-buffer
     (start-process pdebuild-process pdebuild-buffer pdebuild-user-mode-linux-path))
    (set-buffer-process-coding-system 'dos 'dos)))

(defun debuild-pbuilder ()
  "Run `debuild-pbuilder' in the current directory."
  (interactive)

  (let* ((pdebuild-name (concat "debuild-pbuilder" default-directory))
	 (pdebuild-buffer (concat "*" pdebuild-name "*" ))
	 (pdebuild-process (concat "debuild-pbuilder-process-" default-directory))
	 (package-name (devscripts-internal-get-debian-package-name)))
    (switch-to-buffer pdebuild-buffer)
    (toggle-read-only 0)
    (kill-region (point-min) (point-max))
    (pbuilder-log-view-add
     package-name
     (apply 'make-comint pdebuild-name debuild-pbuilder-path nil 
	    debuild-option-list)
     (get-process pdebuild-name))))

(defun pbuilder-build (filename)
  "Run pbuilder build for a given FILENAME. 
Uses `devscripts-mode-gain-root-command' as command to gain root."
  (interactive "f.dsc File name: ")
  (let* ((pbuilder-buffer (concat "*pbuilder-build*" filename))
	 (pbuilder-process (concat "pbuilder-build-process-" filename)))
    (switch-to-buffer pbuilder-buffer)
    (toggle-read-only 0)
    (kill-region (point-min) (point-max))
    (compilation-mode)
    (insert "start compile\n")
    (pbuilder-log-view-add
     (file-name-sans-extension (file-name-nondirectory filename)) pbuilder-buffer
	   (start-process pbuilder-process pbuilder-buffer devscripts-mode-gain-root-command pbuilder-path "build" (expand-file-name filename)))))

(defun pbuilder-user-mode-linux-build (filename)
  "Run pbuilder-user-mode-linux build for a given FILENAME. "
  (interactive "f.dsc File name: ")
  (let* ((pbuilder-buffer (concat "*pbuilder-uml-build*" filename))
	 (pbuilder-process (concat "pbuilder-uml-build-process-" filename)))
    (switch-to-buffer pbuilder-buffer)
    (toggle-read-only 0)
    (kill-region (point-min) (point-max))
    (compilation-mode)
    (insert "start compile\n")
    (pbuilder-log-view-add
     (file-name-sans-extension (file-name-nondirectory filename)) pbuilder-buffer
	   (start-process pbuilder-process pbuilder-buffer pbuilder-user-mode-linux-path "build" (expand-file-name filename)))
    (set-buffer-process-coding-system 'dos 'dos)))



(provide 'pbuilder-mode)
emacs-goodies-el-35.8ubuntu2/elisp/devscripts-el/pbuilder-log-view-mode.el0000775000000000000000000001705412230377265023525 0ustar  ;; Routines to do devscripts-compatible emacs routines.
;; copyright 2002 Junichi Uekawa.

;; This file 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 2, or (at your option)
;; any later version.
;;
;; readme-debian.el 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 your Debian installation, in /usr/share/common-licenses/GPL
;; If not, write to the Free Software Foundation, 675 Mass Ave,
;; Cambridge, MA 02139, USA.

(require 'mcharset)
(defgroup pbuilder-log-view nil "Pbuilder log view mode"
  :group 'tools
  :prefix "pbuilder-log-view-")

(defcustom pbuilder-log-view-web-basepath "/~pbuilder/" "*Elserv path to pbuilder logs."
  :type 'string
  :group 'pbuilder-log-view)

(defvar pbuilder-log-view-build-result-alist nil 
  "Associated list of results of the pbuilder/debuild runs.
They are in (package result-buffer-name process-name(if process exists))

When this variable is being accessed, set `pbuilder-log-view-build-result-alist-mutex' to t.")

(defvar pbuilder-log-view-build-result-alist-mutex nil 
  "The access-control for `pbuilder-log-view-build-result-alist'.
If someone is accessing that var, it is t")

;; potential new interface?
(defvar pbuilder-log-view-results-plist nil 
  "Property list of results of the pbuilder/debuild runs.
:package
:result-buffer-name
:process-name")

;; mutex lock implementation thanks to TSUCHIYA Masatoshi
(defmacro pbuilder-log-view-lock-mutex (mutex &rest body)
  "Try to mutex-lock a variable MUTEX, and run BODY. 

The MUTEX needs to be nil."
  `(progn
     (while ,mutex
       (accept-process-output nil 0 200))
     (setq ,mutex t)
     ,@body
     (setq ,mutex nil)))

;; The following code does publishing for elserv.
;; elserv-start, then run pbuilder-log-view-elserv

(defun pbuilder-log-view-add (package-name buffer-name running-process)
  "Add the entry to the log view list.

\(PACKAGE-NAME, BUFFER-NAME, RUNNING-PROCESS\) will be added to 
`pbuilder-log-view-build-result-alist'.

Argument PACKAGE-NAME is the name of the package."
  (pbuilder-log-view-lock-mutex 
   pbuilder-log-view-build-result-alist-mutex
   (add-to-list 'pbuilder-log-view-build-result-alist (list package-name buffer-name running-process))))

(defun pbuilder-log-view-internal-garbage-collect-log ()
  "Remove unneeded entries from the log listing."
  (setq pbuilder-log-view-build-result-alist
	(let* (new-data current-is-okay)
	  (dolist (entry pbuilder-log-view-build-result-alist)
	    (setq current-is-okay t)
	    (if (get-buffer (cadr entry))
		(dolist (new-data-element new-data)
		  (if (string= (cadr new-data-element) (cadr entry))
		      (setq current-is-okay nil))
		  (if (string= (car new-data-element) (car entry))
		      (setq current-is-okay nil)))
	      (setq current-is-okay nil))
	    (if current-is-okay 
		(add-to-list 'new-data entry)))
	  (reverse new-data))))

(defun pbuilder-log-view-internal-view-one-log (result path ppath request) 
  "View one logfile from buffer.

Requires a newish htmlize.el
RESULT is the resulting value
PATH is relative path from the published path
PPATH is the published path
REQUEST is the request data."
  (let* (logname matching-assoc nowlist charset)
    (string-match "/\\?\\(.+\\).html$" path)
    (setq logname (match-string 1 path))
    (setq nowlist (assoc logname pbuilder-log-view-build-result-alist))
    (if nowlist
	(save-window-excursion
	  (if (get-buffer (cadr nowlist))
	      (progn
		(let* ((htmlize-major-mode nil))
		  (set-buffer (htmlize-buffer-noninteractive (cadr nowlist))))
		(setq charset (detect-mime-charset-region (point-min)(point-max)))
		(elserv-set-result-header 
		 result
		 (list 'content-type (concat "text/html; charset=" (symbol-name charset))))
		(elserv-set-result-body result 
					(encode-mime-charset-string (buffer-string) charset))
		(kill-buffer (current-buffer)))
	    (elserv-set-result-header result (list 'content-type (concat "text/plain")))
	    (elserv-set-result-body result "404?")))
      (elserv-set-result-header result (list 'content-type (concat "text/plain")))
      (elserv-set-result-body result "404p"))))

;; some code sampled from remote.el from elserv sources.
(defun pbuilder-log-view-internal-function (result path ppath request) 
  "Elserv publish function for pbuilder logs.
RESULT, PATH, PPATH and REQUEST are arguments

This page presents the list of build logs available from this Emacs session"
  (pbuilder-log-view-lock-mutex 
   pbuilder-log-view-build-result-alist-mutex
   (pbuilder-log-view-internal-garbage-collect-log))
  (save-window-excursion
    (with-temp-buffer
      (elserv-set-result-header result
				'(content-type "text/html"))
       (insert (concat "


List of builds




    List of builds done in the emacs session
    

    Last updated:" 
			(current-time-string)
			"
    \n"))
	(elserv-set-result-body
	 result
	 (buffer-string))))))

(defcustom pbuilder-log-view-css "
BODY{
color: #ffeeee;
background-color: #000055;
}
h1.title{
   margin-top: 0em;
   border-color: #99c;
   border-width: 0px 9px 4px 0px;
   border-style: solid;
}
div.listing{
   margin-top: 0em;
   border-color: #99c;
   border-width: 0px 0px 4px 9px;
   border-style: solid;
}
li.package{
}
a:link {
  color: #ffccff;
}
a:active {
  color: #eeeeee;
}
a:hover {
  color: #ffffff;
  background-color: #5555ff;
}
a:visited {
  color: #ddeedd;
}
span.status{
  color: #ffffff;
  background-color: #000000;
}
span.buildfail{
  color: #ff3300;
  background-color: #000000;
}
span.buildsuccess{
  color: #00aaff;
  background-color: #000000;
}
" "*Css-string to be added to pbuilder log listing view html page.
h1.title
div.listing
ul.listing
li.package
a.package
span.status
span.buildfail
span.buildsuccess"
  :type 'text
  :group 'pbuilder-log-view)

(defun pbuilder-log-view-elserv ()
  "Run a elserv session with log view.

Running this requires elserv.  Use elserv, and do `elserv-start' before invoking this command."
  (interactive)
  (require 'elserv)
  (require 'htmlize)
  (elserv-publish (elserv-find-process)
		  pbuilder-log-view-web-basepath
		  :function 'pbuilder-log-view-internal-function
		  :description "Build log listing"
		  )
  (elserv-publish (elserv-find-process)
		  (concat pbuilder-log-view-web-basepath "query.cgi")
		  :function 'pbuilder-log-view-internal-view-one-log
		  :description "Build log database query"))


(provide 'pbuilder-log-view-mode)


emacs-goodies-el-35.8ubuntu2/elisp/devscripts-el/ChangeLog0000775000000000000000000002747012230377265020501 0ustar  2005-08-21  Junichi Uekawa  

	* pbuilder-mode.el (pbuilder-build, pbuilder-user-mode-linux-build): 
	add \n after 'start compile' message

2003-10-18  Junichi Uekawa  

	* devscripts.el (debdiff): add new function, debdiff

2003-10-05  Junichi Uekawa  

	* Moved all files to alioth.

2003-09-27  Junichi Uekawa  

	* pbuilder-mode.el (pdebuild-user-mode-linux): set buffer-process-coding-system to dos for user-mode-linux output.
	fix bug.
	(pbuilder-user-mode-linux-build): fix.

2003-09-18  Junichi Uekawa  

	* readme-debian.el: remove from here, alioth has the latest.
	* debian-copyright.el: remove from here, alioth has the latest.

2003-08-25  Junichi Uekawa  

	* readme-debian.el (readme-debian-mode): use write-contents-hooks
	instead of write-file-hooks, and do not make-local-variable, but 
	use the add-hook and LOCAL flag.

2003-06-25  Junichi Uekawa  

	* debian-copyright.el: add patch from PSG for font-lock problem in 
	Xemacs.

2003-05-25  Junichi Uekawa  

	* readme-debian.el: Applied patch from Peter S Galbraith

2003-05-21  Junichi Uekawa  

	* readme-debian.el: accept patch from Peter S Galbraith
	for byte-compilation fixes and many cosmetic fixes.

2003-05-16  Junichi Uekawa  

	* readme-debian.el: defgroup/defcustom.

	* pbuilder-log-view-mode.el (pbuilder-log-view-web-basepath): 
	renamed from pbuilder-log-web-basepath
	Change to defgroup/custom.

	* devscripts.el: defgroup.

	* pbuilder-mode.el (pbuilder-mode): defgroup,
	and change to defcustom.

2003-05-14  Junichi Uekawa  

	* debian-copyright.el (debian-copyright): fix typo.
	(debian-copyright): include patch from Peter S Galbraith.

2003-05-12  Junichi Uekawa  

	* debian-copyright.el: include patch from Peter S Galbraith , who has rewrote most of debian-copyright.el
	
2003-04-02  Junichi Uekawa  

	* devscripts.el (debclean): add debclean

2003-02-10  Junichi Uekawa  

	* pbuilder-mode.el (pdebuild-user-mode-linux): new function.
	(pdebuild-user-mode-linux-path): new variable.

2003-01-08  Junichi Uekawa  

	* pbuilder-mode.el (debuild-pbuilder): convert debuild-pbuilder
	to make-comint.
	(pbuilder-user-mode-linux-path, pbuilder-user-mode-linux-build): 
	support pbuilder-user-mode-linux.

2003-01-07  Junichi Uekawa  

	* devscripts.el (debi): try to use comint for starting up,
	so that it can run interactive.

2002-11-27  Junichi Uekawa  

	* readme-debian.el (readme-debian-font-lock-keywords) 
	(readme-debian-mode): Apply patch from
	James LewisMoss  to make this thing 
	work with xemacs, and then revert the patch because that
	does not really work with emacs21.

2002-11-10  Junichi Uekawa  

	* pbuilder-mode.el: done checkdoc.

	* devscripts.el (devscripts-mode-gain-root-command): done checkdoc.

	* readme-debian.el: done checkdoc.

	* debian-copyright.el: done checkdoc

2002-10-30  Junichi Uekawa  

	* Makefile (distimage): add COPYING file.

	* pbuilder-mode.el (debuild-pbuilder): use debuild-option-list

	* pbuilder-log-view-mode.el (pbuilder-log-view-internal-garbage-collect-log): check the title as well ?
	I will only be able to match via title page.

	* pbuilder-mode.el (debuild-pbuilder): introduce debuild-pbuilder function for running debuild-pbuilder hack.

	* pbuilder-log-view-mode.el (pbuilder-log-view-build-result-alist-mutex): change names 
	(pbuilder-log-view-build-result-alist): change names from debuild-* 

2002-10-29  Junichi Uekawa  

	* pbuilder-log-view-mode.el (pbuilder-log-view-add): use mutex lock
	(pbuilder-log-view-lock-mutex): mutex lock implementation
	(pbuilder-log-view-internal-function): lock mutex.
	(mcharset): require.
	(pbuilder-log-view-internal-view-one-log): ran checkdoc, and fixed some text.
	(pbuilder-log-view-internal-view-one-log): try and use relative paths now.
	(pbuilder-log-view-elserv): publish one base path.
	(pbuilder-log-view-internal-function): remove the hack to generate list of 
	available web pages.

	* pbuilder-mode.el (pdebuild): use pbuilder-log-view-add
	(pbuilder-build): ditto

	* pbuilder-log-view-mode.el (pbuilder-log-view-add): new function

	* devscripts.el (debuild): use pbuilder-log-view-add function

2002-10-28  Junichi Uekawa  

	* pbuilder-log-view-mode.el (pbuilder-log-view-internal-function): move the function
	location to avoid locking up.
	garbage collector needs to lock variables, it seems.
	(pbuilder-log-view-internal-garbage-collect-log): reverse the listing.

	* htmlize.el (htmlize-buffer-noninteractive): new hack from upstream.

	* pbuilder-log-view-mode.el (pbuilder-log-view-mode): change to
	match filename.
	(pbuilder-log-web-basepath): move from pbuilder-mode.el
	(pbuilder-log-view-internal-garbage-collect-log): try garbage collection.
	(pbuilder-log-view-internal-function): try garbage collecting before start.
	(pbuilder-log-view-internal-view-one-log): use htmlize-buffer-noninteractive, provided by 0.68? of htmlize.el

	* pbuilder-mode.el (pbuilder-log-view): require.

	* devscripts.el (pbuilder-log-view): require.

	* pbuilder-log-view-mode.el (pbuilder-log-view): provide pbuilder-log-view

	* Makefile (clean): add clean rule.

	* pbuilder-mode.el: remove things from here.
	* pbuilder-log-view-mode.el: new file, move things related to logview mode over here.

	* htmlize.el: modified last night, merging the modified version into the tree
	until this thing is fixed upstream.

	* pbuilder-mode.el (pbuilder-log-view-elserv): add description
	(pdebuild): fixed typo.

2002-10-27  Junichi Uekawa  

	* pbuilder-mode.el (pbuilder-build): give process information for debuild-results-alist
	(pdebuild): ditto.
	(pbuilder-log-view-internal-function): change the page to use running-status
	of process if it is available.
	(pbuilder-log-view-internal-function): running-status and exit-status are now used to 
	generate information.
	(pbuilder-log-view-internal-function): add  current time to last-updated string ;)
	(pbuilder-log-view-internal-function): reorganized to use with-temp-buffer instead of 
	a massive string variable
	(pbuilder-log-view-internal-view-one-log): set-buffer instead of swith-to-buffer
	(pbuilder-log-view-internal-view-one-log): use save-excursion instead of save-window-excursion
	(pbuilder-log-view-internal-function): use set-buffer
	(pbuilder-log-view-internal-view-one-log): change back to save-window-excursion
	(pbuilder-log-view-internal-view-one-log): use a newly hacked htmlize-buffer.

	* devscripts.el (debuild-option-list): add -us and -uc, because there is no 
	reasonable way (currently) to sign debuilt package inside emacs.
	(debuild): add process information as third member of debuild-results-alist

	* pbuilder-mode.el (pbuilder-log-view-internal-view-one-log): use htmlize-buffer.
	(pbuilder-log-view-internal-view-one-log): kill the htmlized buffer after sending the info.
	(pbuilder-log-view-elserv): require 'htmlize on starting the server, because 
	logs are htmlized.
	(pbuilder-log-view-internal-view-one-log): I don't need the concat of progname here.

2002-10-26  Junichi Uekawa  

	* readme-debian.el (readme-debian-mode-load-hook): add *
	(readme-debian-mode-hook): new var.

	* pbuilder-mode.el (pbuilder-path, pdebuild-path) 
	(pbuilder-log-web-basepath): add *

	* devscripts.el (debuild-option-list): add *
	(devscripts-mode-gain-root-command): add *
	(devscripts-mode-load-hook): add *

	* debian-copyright.el (debian-copyright-mode-load-hook): add * to
	documentation string for customizable value.

2002-10-25  Junichi Uekawa  

	* debian-copyright.el (debian-copyright-mode-version): add version string.

	* devscripts.el (devscripts-mode-version): add version string.

	* pbuilder-mode.el (pbuilder-log-view-function): support charsets.
	(pbuilder-log-view-elserv, pbuilder-log-view-internal-function): rename function to add "internal"
	(pbuilder-log-view-internal-function) 
	(pbuilder-log-view-internal-view-one-log): experimental dynamic log generation.
	(pbuilder-log-view-internal-function): update to be dynamic.
	(pbuilder-log-view-internal-function): provide only the dynamic pages.
	(pbuilder-log-view-elserv): add more notes to the program.
	(pbuilder-mode-version): add version string.

	* devscripts.el (debuild): use devscripts-internal-get-debian-package-name to record the build log.

	* pbuilder-mode.el (pdebuild): use devscripts-internal-get-debian-package-name instead.

	* devscripts.el (debuild-results-alist): move over to devscripts, 
	from pbuilder var.
	(devscripts-internal-get-debian-package-name): new func to get dirname.

	* pbuilder-mode.el (pbuilder-log-view-function)
	(pbuilder-log-web-basepath, pbuilder-log-view-elserv): use pbuilder-log-web-basepath
	as a variable to define the path for the build logs.
	(pbuilder-build): fix name-getting.
	(pbuilder-build): use filename instead of default-directory as identifier.

2002-10-24  Junichi Uekawa  

	* pbuilder-mode.el (pbuilder-results-alist): alist for pbuilder 
	results.
	(pdebuild): get the current package name that is being built, and 
	set the name.
	(pbuilder-build): support adding the build log.
	(pbuilder-log-view-function): Implementation of elserv log viewer 
	for pbuilder session.

	* devscripts.el (debuild-option-list): introduce new option.
	(debuild): use the option, with apply command, etc.

	* pbuilder-mode.el (pbuilder-build, pdebuild, pdebuild-path) 
	(pbuilder-path): define variable to specify pbuilder and pdebuild path.

2002-10-23  Junichi Uekawa  

	* pbuilder-mode.el (pdebuild): new file, new code.
	(pbuilder-build): implement.
	Use devscripts mode variables.
	(pbuilder-build): update, use expand-file-name

	* devscripts.el (debuild): add -i option. I want to make this optional.

2002-10-20  Junichi Uekawa  

	* debian-copyright.el (debian-copyright-mode-load-hook): add

	* readme-debian.el (readme-debian-mode-load-hook): add

	* devscripts.el (devscripts-mode-load-hook): add.

2002-10-19  Junichi Uekawa  

	* debian-copyright.el (debian-copyright-mode): create default.

	* readme-debian.el (readme-debian-mode): add mode map doc.

	* debian-copyright.el (auto-mode-alist): create, modify.

	* devscripts.el: add copyright.

2002-10-17  Junichi Uekawa  

	* readme-debian.el (debian-changelog-mode): require debian-changelog-mode
	(readme-debian-mode): provide readme-debian-mode, not readme-debian
	(readme-debian-update-timestamp): use variables from debian-changelog mode,
	not invent my own.

	* devscripts.el: provide devscripts.

2002-10-16  Junichi Uekawa  

	* readme-debian.el: update copyright.

	* devscripts.el (devscripts-debc-mode-syntax-table): fix.
	(debi, debit): change, new debit function. Use devscripts-mode-gain-root-command
	(devscripts-mode-gain-root-command): new var.

	* readme-debian.el (readme-debian-mode-syntax-table): fix readme-debian-mode-syntax-table.

	* readme-debian.el (readme-debian-mode): add ^[-=]+$ to highlight 
	(auto-mode-alist): add README.Debian in /usr/share/doc

	* Makefile (RELEASE): create make rules.

2002-10-15  Junichi Uekawa  

	* readme-debian.el (readme-debian-mode): implemented something un-cool about this...
	I've done a README.Debian syntax highlighter
	(readme-debian-update-timestamp): create a function to change timestamp.
	(readme-debian-mode): and add hook to use that function on file write.
	(auto-mode-alist): add reamde-debian-mode to auto-mode-alist.

	* devscripts.el (debc, debi, debuild): import from .emacs of myself.
	(devscripts-debc-mode): create a good fontmap, so that things are highlighted properly.

	Copyright GPL.

emacs-goodies-el-35.8ubuntu2/elisp/vm-bonus-el/0000775000000000000000000000000012230377267016274 5ustar  emacs-goodies-el-35.8ubuntu2/elisp/vm-bonus-el/vm-bogofilter.el0000775000000000000000000003546512230377265021410 0ustar  ;;; vm-bogofilter.el version 1.1.4
;;
;; An interface between the VM mail reader and the bogofilter spam filter.
;;
;; Copyright (C) 2003-2006 by Bjorn Knutsson
;;
;; Home page: http://www.cis.upenn.edu/~bjornk/
;;
;; Bjorn Knutsson, CIS, 3330 Walnut Street, Philadelphia, PA 19104-6389, USA
;;
;;
;; Based on vm-spamassassin.el v1.1, Copyright (C) 2002 by Markus Mohnen
;;
;;
;; 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 2 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, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;;; Version history:
;; v 1.1.4: Change in the way bogofilter is called
;;        * No longer uses formail to process mails
;;        * Slightly improved error handling
;; v 1.1.3: Minor edits
;;        * Documentation updates
;;        * Error checking for bogofilter calls.
;;        * vm-bogofilter-delete-spam variable.
;;          Set to cause spam to be automatically deleted.
;;        * vm-bogofilter-setup function.
;;          Automatically called on loading, but can be called again
;;          to re-initialize the vm-bogofilter setup
;; v 1.1.2: Borg assimilation version (12-Sep-2003)
;;        * Great minds think alike. Olivier Cappe independently 
;;          created his own version of vm-bogofilter.el based on
;;          vm-spamassassin.el with the same basic functions.
;;          He submitted a patch to my version to harmonize them.
;;        * Added comment about vm-delete-after-archiving, as suggested
;;          by Olivier.
;; v 1.1.1: minor edits
;;        * Chris McMahan submitted a patch that disables running
;;          bogfilter on incoming mail. While at first potentially
;;          confusing, this means that you can run bogofilter via
;;          e.g. procmail filters, and then use vm-bogofilter.el to
;;          (re-)educate bogofilter about false positives/negatives.
;;        * Documentation of a folder problem added
;; v 1.1: functional update
;;        * Changed re-training functions to also re-tag the the message
;;          in the VM folder, thus making the tag on the message in VM
;;          be consistent with bogofilter's opinion about the message.
;;          Notice!! If you use the tag in the message, you should be
;;          aware that a message re-classified as spam may still not
;;          be tagged as spam by bogofilter, and vice versa, if the
;;          bogofilter database contains too many counter-examples.
;;          The old re-training functions are still present, if you
;;          prefer not to muck around with your inbox. They've been
;;          renamed vm-bogofilter-is-spam-old/vm-bogofilter-is-clean-old
;;          and works as before.
;; v 1.0.1: update
;;        * Very minor edits of texts, no functional changes.
;; v 1.0: initial release
;;        * First release, based on Markus Mohnen's vm-spamassassin
;;
;;
;; To use this program, you need reasonably recent versions of VM from
;; http://www.wonderworks.com/vm) and bogofilter from
;; http://sourceforge.net/projects/bogofilter/
;;
;; This version of the interface has been developed for, and tested
;; with, VM version 7.17 and later, and bogofilter version 0.17.4 and
;; later. Some features used /require/ bogofilter version 0.15.0 and
;; later but no testing of versions earlier than 0.17.4 has been done.
;; It has been tested with bogofilter versions up to 0.93.2
;;
;; (Former RMAIL-users should read the BUGS-note about the BABYL-format)
;;
;;; Installation:
;;
;;  Put this file on your Emacs-Lisp load path and add following into your
;;  ~/.vm startup file
;;
;;      (require 'vm-bogofilter)
;;
;;
;;; Usage:
;;
;; Whenever you get new mail bogofilter will be invoked on them. Mail
;; detected as spam will be tagged by bogofilter, and you can use
;; existing mechanisms to dispose of them.
;;
;; For example, if you append this line to your .vm (or modify your
;; existing auto-folder-alist), you could then have messages tagged as
;; spam automatically saved in a separate 'spam' folder:
;;
;; (setq vm-auto-folder-alist '(("^X-Bogosity: " ("Yes," . "spam"))))
;;
;; If you want your auto-folder to be used every time you've received
;; new mail, just add the following to your .vm:
;;
;; (add-hook 'vm-arrived-messages-hook 'vm-auto-archive-messages)
;;
;; You can also set (setq 'vm-delete-after-archiving t) to make VM
;; automatically delete archived spams from the main folder.
;;
;;
;; If a message is tagged as spam incorrectly, you can re-train
;; bogofilter by calling the function vm-bogofilter-is-clean on that
;; message. Similarly, calling vm-bogofilter-is-spam will re-train
;; bogofilter to recognize a clean-marked message as spam.
;;
;; These functions can be bound to keys in your .vm, for example:
;;
;; (define-key vm-mode-map "K" 'vm-bogofilter-is-spam)
;; (define-key vm-mode-map "C" 'vm-bogofilter-is-clean)
;;
;; would define K (shift-k) as the key to declare the current message
;; as spam, while C (shift-c) as the key to declare the current
;; message as clean.
;;
;; Re-training with the old functions (still available) would not
;; re-tag messages, while the new ones will. Re-training may or may
;; not change the spam-status of a message. Because of the way
;; bogofilter works, even a message explicitly declared as spam may
;; not be tagged as spam if there are enough similar non-spam
;; messages. Remember, bogofilter is not trained to recognize
;; individual messages, but rather patterns. You may have to train
;; bogofilter on a number of spam messages before it recognizes any of
;; them as spam. See the documentation for bogofilter. Notice also
;; that even if the tag changes, this will not undo actions previously
;; taken based on the tag, e.g. moving spam to a spamfolder with
;; auto-folders.
;;
;; If you have a small database, running bogofilter without '-u' may
;; be better in the beginning. If you want to run without '-u', it
;; can easily be accomplished. Just:
;; 
;; M-x customize vm-bogofilter
;;
;; Then change the Program Options to just '-p -e' and the Unspam to
;; '-n' and Spam to '-s'.
;;
;; Now, bogofilter will not auto-train, and you must instead use the
;; vm-bogofilter-is-spam and vm-bogofilter-is-clean to manually tag
;; messages. (If you've bound them to keys, it will be quite simple.)
;;
;;; BUGS:
;;
;; One know bug is that formail will not like it if the input is not
;; in the format it expects and knows. Even though it's supposed to
;; know BABYL, this does not work.
;;
;; A related problem is that if you have the wrong folder type
;; selected, then sometimes, VM will merge messages. You can check the
;; raw folder to see if you have a blank line before the "From "-line
;; separating messages. See the documentation for vm-default-folder-type
;;
;; vm-bogofilter is not very smart about errors. If an error occurs
;; during any operation that tags or re-tags messages, the message(s)
;; being processed will be *lost*. If errors occur during initial
;; processing, the lost mails can sometimes be recovered since VM will
;; save the folder *after* receiving new mails, but *before*
;; processing hooks, e.g. vm-bogofilter. If you notice the errors
;; before saving the folder, you can copy the old file, close VM,
;; rename your copy to the original folder name and then start VM
;; again. Naturally, anything that happened to the folder after
;; fetching new mail will be lost, e.g. bogofilter tagging etc.
;;
;;; Customization:
;;
;;  M-x customize RET vm-bogofilter

;;; Code:

(eval-when-compile (require 'vm))

;;; Customisation:

(defgroup vm-bogofilter nil
  "VM Spam Filter Options"
  :group 'vm)

(defcustom vm-bogofilter-program "bogofilter"
  "*Name of the bogofilter program."
  :group 'vm-bogofilter
  :type 'string)

(defcustom vm-bogofilter-program-options "-u -p -e"
  "*Options for the bogofilter program. Since we use bogofilter as a
filter, '-p' must be one of the options, while '-e' tells bogofilter
that it is embedded, and thus should not signal spam/ham with return
values.
* The flag '-u' controls if bogofilter automatically learns from its own
classification. You may not want to use this flag if bogofilter still is
learning to classify, or if you do not have the discipline to correct every
mis-classification."
  :group 'vm-bogofilter
  :type 'string)

(defcustom vm-bogofilter-program-mbox "-M"
  "*Options for the bogofilter program. This flags tells bogofilter
how to process mailboxes, i.e., multiple messages."
  :group 'vm-bogofilter
  :type 'string)

(defcustom vm-bogofilter-program-options-unspam "-Sn"
  "*Options for the bogofilter program when declaring a spam-marked
message as clean. The default, '-Sn', assumes that bogofilter already
has trained itself on the message, e.g. by running it with '-u' during
classification. If this is the initial training, use '-n' instead."
  :group 'vm-bogofilter
  :type 'string)

(defcustom vm-bogofilter-program-options-spam "-Ns"
  "*Options for the bogofilter program when declaring a clean-marked
message as spam. The default, '-Ns', assumes that bogofilter already
has trained itself on the message, e.g. by running it with '-u' during
classification. If this is the initial training, use '-s' instead."
  :group 'vm-bogofilter
  :type 'string)

(defcustom vm-bogofilter-program-options-reclassify "-p -e"
  "*Options for the bogofilter program when declaring a clean-marked
message as spam.
*See vm-bogofilter-program-options for a discussion of the options."
  :group 'vm-bogofilter
  :type 'string)

(defcustom vm-bogofilter-formail-program "formail"
  "*Name of the program used to split a sequence of mails."
  :group 'vm-bogofilter
  :type 'string)

(defcustom vm-bogofilter-formail-program-options "-s"
  "*Options for the 'vm-bogofilter-formail-program'. After this
arguments, the name of the bogofilter program will be passed."
  :group 'vm-bogofilter
  :type 'string)

(defcustom vm-bogofilter-invoke-through-vm t
  "*When true, bogofilter will be invoked through the
vm-retrieved-spooled-mail-hook. If you have procmail or some other
MTA configured to filter through bogofilter already, then set this to
nil to speed vm-startup.
*NOTE: This variable is only consulted on startup, so if you change
it, it will take effect the next time vm-bogofilter is loaded, or
vm-bogofilter-setup is called."
  :group 'vm-bogofilter
  :type 'boolean)

(defcustom vm-bogofilter-delete-spam nil
  "*When true, mark messages for deletion when reclassifying as spam.
*NOTE: This does not affect the initial classification, only when messages
are explicitly marked as spams by the vm-bogofilter-is-spam function."
  :group 'vm-bogofilter
  :type 'boolean)

(defun vm-bogofilter-arrived-message ()
  "The function used to do the actual filtering. It is used as a value for
vm-retrieved-spooled-mail-hook."
  (save-excursion
    (vm-save-restriction
     (let ((tail-cons (vm-last vm-message-list))
	   (buffer-read-only nil))
       (widen)
       (if (null tail-cons)
	   (goto-char (point-min))
	 (goto-char (vm-text-end-of (car tail-cons)))
	 (beginning-of-line)
	 (forward-line)
	 )
       (message "Filtering new messages... ")
       (let ((res (call-process-region (point) (point-max)
				       (or shell-file-name "sh")
				       t t nil shell-command-switch
				       (concat vm-bogofilter-program " "
					       vm-bogofilter-program-options " "
					       vm-bogofilter-program-mbox))))

	 (if (and res (not (and (integerp res) (zerop res))))
	     (error "Something went wrong filtering new messages (exit %s)"
		    res)
	   (delete-region (point) (point-max))))
       (message "Filtering new messages... done.")
       )
     )
    )
  )

(defun vm-bogofilter-is-spam-old ()
  "Declare that a clean-marked message is spam"
  (interactive)
  (vm-follow-summary-cursor)
  (vm-pipe-message-to-command
   (concat vm-bogofilter-program " " vm-bogofilter-program-options-spam) nil)
  )

(defun vm-bogofilter-is-clean-old ()
  "Declare that a spam-marked message is clean"
  (interactive)
  (vm-follow-summary-cursor)
  (vm-pipe-message-to-command
   (concat vm-bogofilter-program " " vm-bogofilter-program-options-unspam) nil)
  )

(defun vm-bogofilter-is-spam ()
  "Declare that a clean-marked message is spam, and re-tag message"
  (interactive)
  (vm-bogofilter-retag "spam" vm-bogofilter-program-options-reclassify vm-bogofilter-program-options-spam)
  (if vm-bogofilter-delete-spam
      (vm-delete-message 1)) 
  )

(defun vm-bogofilter-is-clean ()
  "Declare that a spam-marked message is clean, and re-tag message"
  (interactive)
  (vm-bogofilter-retag "clean" vm-bogofilter-program-options-reclassify vm-bogofilter-program-options-unspam)
  )

;; Based on vm-pipe-message-to-command
(defun vm-bogofilter-retag (text switch &optional switch2)
  "Workhorse function for re-tagging of messages."
  (vm-follow-summary-cursor)
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-read-only)
  (vm-error-if-folder-empty)
  (save-excursion
    (let ((message (vm-real-message-of (car vm-message-pointer)))
	  (buffer (get-buffer-create "*Shell Command Output*"))
	  )
          
      (save-excursion
	(set-buffer buffer)
	(erase-buffer))
      (set-buffer (vm-buffer-of message))
      (vm-save-restriction
       (vm-save-buffer-excursion
	(widen)
	(goto-char (vm-headers-of message))
	(narrow-to-region (point) (vm-text-end-of message))
	(message "Re-classifying message as %s." text)
	(if (not (eq switch2 nil))
	    (progn
	      (call-process-region (point-min) (point-max)
				   (or shell-file-name "sh")
				   nil buffer nil shell-command-switch
				   (concat vm-bogofilter-program " "
					   switch2)
				   )
	      (message "Message re-classified as %s, updating tag."
		       text)
	      ))
	(let ((buffer-read-only nil)
	      (buffer (get-buffer-create "*Shell Command Output*")))
	  (call-process-region (point-min) (point-max)
			       (or shell-file-name "sh")
			       nil t nil shell-command-switch
			       (concat vm-bogofilter-program " "
				       switch)
			       )
	  (delete-region (point) (vm-text-end-of message)))
	(vm-discard-cached-data)
	(message "Message re-classified and tagged as %s." text)
	(vm-preview-current-message)
	(vm-update-summary-and-mode-line)
	)))))

;;; Hooking into VM

(defun vm-bogofilter-setup ()
  "Initialize vm-bogofilter."
  (interactive)
  (if vm-bogofilter-invoke-through-vm
      (add-hook 'vm-retrieved-spooled-mail-hook 'vm-bogofilter-arrived-message)
      (remove-hook 'vm-retrieved-spooled-mail-hook 'vm-bogofilter-arrived-message)))

(vm-bogofilter-setup)
  
(provide 'vm-bogofilter)

;;; vm-bogofilter.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/dpkg-dev-el/0000775000000000000000000000000012243644073016223 5ustar  emacs-goodies-el-35.8ubuntu2/elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.el0000775000000000000000000001041612230377265022432 0ustar  ;;; dpkg-dev-el-loaddefs.el --- automatically extracted autoloads
;;
;;; Code:

(provide 'dpkg-dev-el-loaddefs)

;;;### (autoloads (emacs-bts-control debian-bts-control) "debian-bts-control"
;;;;;;  "debian-bts-control.el" (19331 13289))
;;; Generated autoloads from debian-bts-control.el

(autoload 'debian-bts-control "debian-bts-control" "\
Contruct a message with initial ACTION command for control@bugs.debian.org.
Contructs a new control command line if called from within the message
being constructed.

If prefix arg is provided, use the current buffer instead instead of
creating a new outgoing email message buffer.
The current buffer is also used if the current major mode matches one listed
in `debian-bts-control-modes-to-reuse'.

\(fn ACTION &optional ARG)" t nil)

(autoload 'emacs-bts-control "debian-bts-control" "\
Contruct a message with ACTION command for control@debbugs.gnu.org.
Contructs a new control command line if called from within the message
being constructed.

If prefix arg is provided, use the current buffer instead instead of
creating a new outgoing email message buffer.
The current buffer is also used if the current major mode matches one listed
in `debian-bts-control-modes-to-reuse'.

\(fn ACTION &optional ARG)" t nil)

;;;***

;;;### (autoloads (debian-changelog-mode debian-changelog-add-entry)
;;;;;;  "debian-changelog-mode" "debian-changelog-mode.el" (19196
;;;;;;  33072))
;;; Generated autoloads from debian-changelog-mode.el

(autoload 'debian-changelog-add-entry "debian-changelog-mode" "\
Add a new change entry to a debian-style changelog.
If called from buffer other than a debian/changelog, this will search
for the debian/changelog file to add the entry to.

\(fn)" t nil)

(autoload 'debian-changelog-mode "debian-changelog-mode" "\
Major mode for editing Debian-style change logs.
Runs `debian-changelog-mode-hook' if it exists.

Key bindings:

\\{debian-changelog-mode-map}

If you want to use your debian.org email address for debian/changelog
entries without using it for the rest of your email, use the `customize`
interface to set it, or simply set the variable
`debian-changelog-mailing-address' in your ~/.emacs file, e.g.

 (setq debian-changelog-mailing-address \"myname@debian.org\"))

\(fn)" t nil)
(add-to-list 'auto-mode-alist '("/debian/*NEWS" . debian-changelog-mode))
(add-to-list 'auto-mode-alist '("NEWS.Debian" . debian-changelog-mode))
(add-to-list 'auto-mode-alist '("NEWS.Debian.gz" . debian-changelog-mode))
(add-to-list 'auto-mode-alist '("/debian/\\([[:lower:][:digit:]][[:lower:][:digit:].+-]+\\.\\)?changelog\\'" . debian-changelog-mode))
(add-to-list 'auto-mode-alist '("changelog.Debian" . debian-changelog-mode))
(add-to-list 'auto-mode-alist '("changelog.Debian.gz" . debian-changelog-mode))
(add-to-list 'auto-mode-alist '("changelog.dch" . debian-changelog-mode))

;;;***

;;;### (autoloads (debian-control-mode) "debian-control-mode" "debian-control-mode.el"
;;;;;;  (18850 58753))
;;; Generated autoloads from debian-control-mode.el

(autoload 'debian-control-mode "debian-control-mode" "\
A major mode for editing Debian control files (i.e. debian/control).

\(fn)" t nil)
(add-to-list 'auto-mode-alist '("/debian/control\\'" . debian-control-mode))

;;;***

;;;### (autoloads (debian-copyright-mode) "debian-copyright" "debian-copyright.el"
;;;;;;  (16295 49413))
;;; Generated autoloads from debian-copyright.el

(autoload (quote debian-copyright-mode) "debian-copyright" "\
Mode to edit and read debian/copyright.
\\{debian-copyright-mode-map}" t nil)
(add-to-list 'auto-mode-alist '("debian/.*copyright$" . debian-copyright-mode))
(add-to-list 'auto-mode-alist '("^/usr/share/doc/.*/copyright" . debian-copyright-mode))

;;;***

;;;### (autoloads nil nil ("dpkg-dev-el.el") (19331 13614 16291))

;;;***

;;;### (autoloads (readme-debian-mode) "readme-debian" "readme-debian.el"
;;;;;;  (17503 21939))
;;; Generated autoloads from readme-debian.el

(autoload (quote readme-debian-mode) "readme-debian" "\
Mode for reading and editing README.Debian files.
Upon saving the visited README.Debian file, the timestamp at the bottom
will be updated.

\\{readme-debian-mode-map}" t nil)
(add-to-list 'auto-mode-alist '("debian/.*README.*Debian$" . readme-debian-mode))
(add-to-list 'auto-mode-alist '("^/usr/share/doc/.*/README.*Debian.*$" . readme-debian-mode))

;;;***
emacs-goodies-el-35.8ubuntu2/elisp/dpkg-dev-el/debian-control-mode.el0000775000000000000000000004637512230377265022413 0ustar  ;;; debian-control-mode.el --- major mode for Debian control files

;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
;; Copyright (C) 2003-2005, 2007-2011 Peter S Galbraith 

;; Author: Colin Walters 
;; Maintainer: Peter S Galbraith 
;; Created: 29 Nov 2001
;; Version: 1.5
;; X-RCS: $Id: debian-control-mode.el,v 1.19 2013/10/15 17:22:44 psg Exp $
;; Keywords: convenience

;; This file 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 2, or (at your option)
;; any later version.
;;
;; debian-control-mode.el 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 your Debian installation, in /usr/share/common-licenses/GPL
;; If not, write to the Free Software Foundation, 675 Mass Ave,
;; Cambridge, MA 02139, USA.

;;; Commentary:

;; debian-control-mode.el is developed under Emacs 21, and is targeted
;; for use in Emacs 21 and relatively recent versions of XEmacs.

;;; Change Log:

;; V1.5 (2011-08-16) Added "Multi-Arch:" (Closes #634162)

;; V1.4 (2011-06-24) Added "XS-Python-Version" to debian-control-source-fields
;;  (Closes #591697)

;; V1.3 (2010-05-07) Added "Breaks" to debian-control-binary-fields
;;  (Closes #580501)

;; V1.2a (2009-02-23) Applied patch from Morten Kjeldgaard changing
;;      Dm-Upload-Allowed to DM-Upload-Allowed (Closes: #508748)

;; V1.2 (2008-01-17)  Cyril Brulebois 
;; - Add "Dm-Upload-Allowed" field to source fields.

;; V1.1 (2007-10-18)  Cyril Brulebois 
;; - Renamed "XS-Vcs-*" fields into "Vcs-*", officially supported since
;;   dpkg/1.14.7.

;; V1.0 (2007-10-01)  Cyril Brulebois 
;; - Add "Homepage" field to source fields.
;; - Add "XS-Vcs-*" fields to source fields, patch contributed by
;;   Rafael Laboissiere  (Closes: #422491).

;; V0.9 (2005-11-22)  Peter S Galbraith 
;; - Make # the comment character. (Closes: #339868)

;; V0.8 (2005-02-07)  Peter S Galbraith 
;; - Change mouse-2 binding to C-mouse-2 (Closes: #293629)
;; - Fix debian-control-mode-bugs-mouse-click to create correct
;;   text-properties of package names.

;; V0.7 (2004-03-27)  Peter S Galbraith 
;;
;; * Apply patch from Jhair Tocancipa Triana 
;;   in http://bugs.debian.org/226770.  Fixes an after-change-functions race.

;; V0.6 (2003-11-27)  Peter S Galbraith 
;;
;; * Only fontify known fields (to better catch misspellings) (Closes: #213779)
;; * Add "Uploaders" field; Add "Section" and "Priority" also to binary fields.
;; * Call `goto-address' in major-mode to clickify URLs.
;; * http://cvs.verbum.org/debian/debian-control-mode link removed.

;; V0.5 (2003/10/16)  Peter S Galbraith 
;;
;; * Add "View upgrading-checklist" to control menu.
;; * Added debian-control-find-file to make this work on XEmacs.

;; Changes from 0.3 to 0.4:
;;
;; * Don't depend on face properties to find names of packages.
;; * Use an after-change-function to put special text properties on,
;;   instead of using font-lock to do it.  That way they'll be added
;;   regardless of the value of `font-lock-mode'.
;; * Fix up portable definition of `with-auto-compression-mode'.

;; Changes from 0.2 to 0.3:
;;
;; * Fix bug in filling description lines.
;; * Clicking on a source or binary package name shows bugs for that
;;   package.
;; * New function `debian-control-mode-add-field', bound to 'C-c C-a'
;;   by default.
;; * New function `debian-control-visit-policy', bound to 'C-c C-p'
;;   by default.
;; * New function `debian-control-view-package-bugs', bound to 'C-c C-b'
;;   by default.
;; * Initial menu support.
;; * Initial customize support.
;; * Imenu support.
;; * Initial attempts at XEmacs support.
;; * Use the term "field" instead of "header".

;; Changes from 0.1 to 0.2:
;;
;; * Tighten up regexps; whitespace before and after a field value is
;;   insignificant.  Also, package names may contain '+' and '.'.
;; * Add more comments for compliance with Emacs Lisp coding standards.
;; * Allow filling of a regular field to work.
;; * Provide `debian-control-mode'.

;;; Bugs:

;; Filling doesn't work on XEmacs.  I have no idea why.
;; Mouse stuff doesn't work on XEmacs.
;; Emacs 20 isn't supported.

;;; Code:

(require 'easymenu)
(require 'font-lock)
(eval-when-compile
  (require 'cl))

;; XEmacs compatibility
(eval-and-compile
  (unless (fboundp 'line-beginning-position)
    (defun line-beginning-position ()
      (save-excursion
	(beginning-of-line)
	(point))))
  (unless (fboundp 'line-end-position)
    (defun line-end-position ()
      (save-excursion
	(end-of-line)
	(point))))
  (unless (fboundp 'match-string-no-properties)
    (defalias 'match-string-no-properties 'match-string)))

(defgroup debian-control nil "Debian control file maintenance"
  :group 'tools)

(defcustom debian-control-source-package-face 'font-lock-type-face
  "The face to use for highlighting source package names."
  :type 'face
  :group 'debian-control)

(defcustom debian-control-binary-package-face 'font-lock-variable-name-face
  "The face to use for highlighting binary package names."
  :type 'face
  :group 'debian-control)

(defvar debian-control-syntax-table nil
  "Syntax table used in debian-control-mode buffers.")

(if debian-control-syntax-table
    ()
  (setq debian-control-syntax-table (make-syntax-table))
  ;; Support # style comments
  (modify-syntax-entry ?#  "<"  debian-control-syntax-table)
  (modify-syntax-entry ?\n "> " debian-control-syntax-table))

;; FIXME: As of policy 3.5.6.0, the allowed characters in a field name
;; are not specified.  So we just go with "word constituent" or '-'
;; characters before a colon.
(defvar debian-control-field-regexp "^\\(\\(\\sw\\|-\\)+:\\)")
(defvar debian-control-package-name-regexp "\\([-a-zA-Z0-9+.]+?\\)")

(defvar debian-control-mode-package-name-keymap (make-sparse-keymap))

;; An uptodate list can be found at:
;;   http://svn.debian.org/wsvn/qa/trunk/pts/www/bin/common.py?op=file
(defvar debian-control-vcs-names
  '("Arch" "Bzr" "Cvs" "Darcs" "Git" "Hg" "Mtn" "Svn")
  "Valid VCS names for the Vcs-* field.")

(defvar debian-control-source-fields
  (append
  '("Section" "Priority" "Maintainer" "Build-Depends" "Build-Depends-Indep"
     "Build-Conflicts" "Build-Conflicts-Indep" "Standards-Version" "Uploaders"
     "DM-Upload-Allowed" "Homepage" "Vcs-Browser" "XS-Python-Version")
   (mapcar (lambda (elt) (concat "Vcs-" elt))
           debian-control-vcs-names))
  "Valid source package field names, collected from several policy sections.")

(defvar debian-control-binary-fields
  '("Section" "Priority" "Architecture" "Depends" "Conflicts" "Pre-Depends"
    "Essential" "Provides" "Recommends" "Suggests" "Replaces" "Enhances"
    "Description" "Breaks")
  "Valid binary package field names, collected from several policy sections.")

(defvar debian-control-source-fields-regexp
  (concat
   "^\\("
   (let ((max-specpdl-size 1000))
     (regexp-opt debian-control-source-fields t))
   "\\):")
  "font-lock regexp matching known fields in the source section.")

(defvar debian-control-binary-fields-regexp
  (concat
   "^\\("
   (let ((max-specpdl-size 1000))
     (regexp-opt debian-control-binary-fields t))
   "\\):")
  "font-lock regexp matching known fields in the binary section.")

(defvar debian-control-font-lock-keywords
  `((,(concat "^\\(Source:\\)\\s-*"
	      debian-control-package-name-regexp
	      "\\s-*$")
     (1 font-lock-keyword-face)
     ,(list 2
	    (if (featurep 'xemacs)
		'(symbol-value debian-control-source-package-face)
	      '(list 'face debian-control-source-package-face))
	   nil nil))
    ("^\\(Multi-Arch:\\)\\s-*\\(same\\|foreign\\|allowed\\)"
     (1 font-lock-function-name-face)
     (2 font-lock-keyword-face))
    (,debian-control-source-fields-regexp
     (1 font-lock-keyword-face))
    (,debian-control-binary-fields-regexp
     (1 font-lock-function-name-face))))

(defvar debian-control-mode-menu nil)

;;;###autoload
(define-derived-mode debian-control-mode fundamental-mode "Debian Control"
  "A major mode for editing Debian control files (i.e. debian/control)."
  (if (< emacs-major-version 21)
      (message "debian-control-mode only supports emacsen version >= 21; disabling features")
    (progn
      (set-syntax-table debian-control-syntax-table)
      ;; Comments
      (make-local-variable 'comment-start-skip)  ;Need this for font-lock...
      (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *") ;;From perl-mode
      (make-local-variable 'comment-start)
      (make-local-variable 'comment-end)
      (setq comment-start "#"
            comment-end "")

      (make-local-variable 'font-lock-defaults)
      (setq font-lock-defaults
            '(debian-control-font-lock-keywords
              nil           ;;; Keywords only? No, let it do syntax via table.
              nil           ;;; case-fold?
              nil           ;;; Local syntax table.
              nil           ;;; Use `backward-paragraph' ? No
              ))
      (set (make-local-variable 'fill-paragraph-function)
	   #'debian-control-mode-fill-paragraph)
      (make-local-variable 'after-change-functions)
      (push 'debian-control-mode-after-change-function after-change-functions)
      (set (make-local-variable 'imenu-generic-expression)
        '((nil "^\\(Package\\|Source\\):\\s-*\\([-a-zA-Z0-9+.]+?\\)\\s-*$" 2)))

      (define-key debian-control-mode-map (kbd "C-c C-b") 'debian-control-view-package-bugs)
      (define-key debian-control-mode-map (kbd "C-c C-p") 'debian-control-visit-policy)
      (define-key debian-control-mode-map (kbd "C-c C-a") 'debian-control-mode-add-field)
      (define-key debian-control-mode-package-name-keymap (if (featurep 'xemacs)
							      [(control down-mouse-2)]
							    [(C-mouse-2)])
	'debian-control-mode-bugs-mouse-click)
      (easy-menu-add debian-control-mode-menu)
      (if (and (featurep 'goto-addr) goto-address-highlight-p)
        (goto-address))
      (let ((after-change-functions nil))
	(debian-control-mode-after-change-function (point-min) (point-max) 0)))))

(defun debian-control-mode-after-change-function (beg end len)
  (save-excursion
    (let ((modified (buffer-modified-p))
	  (buffer-read-only nil)
          (data (match-data)))
      (unwind-protect
	  (progn
	    (goto-char beg)
	    (beginning-of-line)
	    (while (< (point) end)
	      (cond ((looking-at (concat "^\\(Source:\\)\\s-*"
					 debian-control-package-name-regexp
					 "\\s-*$"))
		     (add-text-properties
		      (match-beginning 2) (match-end 2)
		      `(mouse-face
			highlight
			debian-control-mode-package ,(match-string 2)
			help-echo "C-mouse-2: View bugs for this source package"
			keymap ,debian-control-mode-package-name-keymap)))
		    ((looking-at (concat "^\\(Package:\\)\\s-*"
					 debian-control-package-name-regexp
					 "\\s-*$"))
		     (add-text-properties
		      (match-beginning 2) (match-end 2)
		      `(mouse-face
			highlight
			debian-control-mode-package ,(match-string 2)
			help-echo "C-mouse-2: View bugs for this binary package"
			keymap ,debian-control-mode-package-name-keymap)))
		    (t nil))
	      (forward-line 1)))
	 (set-match-data data)
         (set-buffer-modified-p modified)))))

(easy-menu-define
 debian-control-mode-menu debian-control-mode-map "Debian Control Mode Menu"
 '("Control"
   ["Add field at point" debian-control-mode-add-field t]
   "--"
   "Policy"
    ["View upgrading-checklist" (debian-control-visit-policy 'checklist)
     (file-exists-p "/usr/share/doc/debian-policy/upgrading-checklist.txt.gz")]
    ["View policy (text)" (debian-control-visit-policy 'text)
     (file-exists-p "/usr/share/doc/debian-policy/policy.txt.gz")]
    ["View policy (HTML)" (debian-control-visit-policy 'html) t]
   "--"
   "Access www.debian.org"
   ["Bugs for package" debian-control-view-package-bugs t]
   ["Specific bug number" (debian-changelog-web-bug) nil]
;;   ["Package list (all archives)" (debian-changelog-web-packages) t]
;;  ("Package web pages..."
;;   ["stable" (debian-changelog-web-package "stable") t]
;;   ["testing" (debian-changelog-web-package "testing") t]
;;   ["unstable" (debian-changelog-web-package "unstable") t])
   "--"
   ["Customize" (customize-group "debian-control") t]))

(defun debian-control-mode-fill-paragraph (&rest args)
  (let (beg end)
    (save-excursion
      ;; Are we looking at a field?
      (if (save-excursion
	    (beginning-of-line)
	    (looking-at debian-control-field-regexp))
	  (setq beg (match-end 0)
		end (line-end-position))
	;; Otherwise, we're looking at a description; handle filling
	;; areas separated with "."  specially
    (setq beg (save-excursion
                 (beginning-of-line)
                 (while (not (or (bobp)
                                 (looking-at "^\\sw-*$")
                                 (looking-at "^ \\.")
                                 (looking-at debian-control-field-regexp)))
                   (forward-line -1))
                 (unless (eobp)
                   (forward-line 1))
                 (point))
          end (save-excursion
                 (beginning-of-line)
                 (while (not (or (eobp)
                                 (looking-at "^\\sw-*$")
                                 (looking-at debian-control-field-regexp)
                                 (looking-at "^ \\.")))
                   (forward-line 1))
                 (unless (bobp)
                   (forward-line -1)
		   (end-of-line))
                 (point))))
      (let ((fill-prefix " "))
	(apply #'fill-region beg end args)))))

(defun debian-control-mode-add-field (binary field)
  "Add a field FIELD to the current package; BINARY means a binary package."
  (interactive
   (let* ((binary-p (if (or (save-excursion
			      (beginning-of-line)
			      (looking-at "^\\(Package\\|Source\\)"))
			    (re-search-backward "^\\(Package\\|Source\\)" nil t))
			(not (not (string-match "Package" (match-string 0))))
		      (error "Couldn't find Package or Source field")))
	  (fields (if binary-p
		      debian-control-binary-fields
		    debian-control-source-fields))
          (completion-ignore-case t))
     (list
      binary-p
      (completing-read (format "Add %s package field: " (if binary-p "binary" "source"))
                       (mapcar #'(lambda (x) (cons x nil)) fields)))))
  (require 'cl)
  (let ((fields (if binary
		    debian-control-binary-fields
		  debian-control-source-fields))
	(beg (save-excursion
	       (beginning-of-line)
	       (while (not (or (bobp)
			       (looking-at "^\\s-*$")))
		 (forward-line -1))
	       (forward-line 1)
	       (point)))
	(end (save-excursion
	       (beginning-of-line)
	       (while (not (or (eobp)
			       (looking-at "^\\s-*$")))
		 (forward-line 1))
	       (point))))
    (save-restriction
      (narrow-to-region beg end)
      (let ((curfields (let ((result nil))
			 (goto-char (point-min))
			 (while (not (eobp))
			   (when (looking-at debian-control-field-regexp)
			     (push (cons (subseq
					  ;; Text properties are evil
					  (match-string-no-properties 1)
					  0
					  ;; Strip off the ':'
					  (- (match-end 1)
					     (match-beginning 1)
					     1))
					 (match-beginning 0))
				   result))
			   (forward-line 1))
			 result))
	    (x nil))
	;; If the field is already present, just jump to it
	(if (setq x (assoc field curfields))
	    (goto-char (cdr x))
	  (let* ((pos (or (position field fields :test #'string-equal)
                          -1))
		 (prevfields (reverse (subseq fields 0 pos)))
		 (nextfields (subseq fields (1+ pos))))
	    (if (not (wholenump pos))
                (goto-char (cdar curfields))
	      (when prevfields
                (while (and (car prevfields)
                            (not (assoc (car prevfields) curfields)))
                  (pop prevfields))
                (goto-char (cdr (assoc (car prevfields) curfields)))
                (setq prevfields nil nextfields nil))
	      (when nextfields
                (while (and (car nextfields)
                            (not (assoc (car nextfields) curfields)))
                  (pop nextfields))
                (goto-char (cdr (assoc (car nextfields) curfields)))
                (setq prevfields nil nextfields nil)))
	    ;; Hack: we don't want to add fields after Description
	    (beginning-of-line)
	    (when (looking-at "^Description")
	      (forward-line -1))
	    (end-of-line)
	    (insert "\n" (upcase-initials field) ": ")))))))

(defun debian-control-visit-policy (format)
  "Visit the Debian Policy manual in format FORMAT.
Currently valid FORMATs are `html', `text' and `checklist'.
The last one is not strictly a format, but visits the upgrading-checklist.txt
text file."
  (interactive
   (list (intern
	  (completing-read "Policy format: "
                           (mapcar #'(lambda (x) (cons x 0))
                                   '("html" "text" "checklist"))
			   nil t))))
  (case format
    (text
     (debian-control-find-file "/usr/share/doc/debian-policy/policy.txt.gz"))
    (checklist
     (debian-control-find-file
      "/usr/share/doc/debian-policy/upgrading-checklist.txt.gz"))
    (html
     (require 'browse-url)
     (browse-url
      (if (file-exists-p "/usr/share/doc/debian-policy/policy.html/index.html")
	  "file:///usr/share/doc/debian-policy/policy.html/index.html"
	(prog1
	    "http://www.debian.org/doc/debian-policy"
	  (message "Note: package `debian-policy' not installed, using web version")))))
    (t
     (error "Unknown format %s for policy" format))))

(defun debian-control-find-file (file)
  "Find-file a possibly compressed FILE"
  (require 'jka-compr)
  (let ((installed (jka-compr-installed-p)))
    (if (not installed)
        (auto-compression-mode t))
    (find-file file)
    (if (not installed)
        (auto-compression-mode -1))))

(defun debian-control-mode-bugs-mouse-click (event)
  "Display the bugs for the package name clicked on."
  (interactive "e")
  (mouse-set-point event)
  (let ((prop (get-text-property (point) 'debian-control-mode-package)))
    (unless prop
      (error "Couldn't determine package name at point"))
    (debian-control-view-package-bugs prop)))

(defun debian-control-mode-bug-package-names ()
  (let ((result nil))
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
	(when (looking-at "^\\(Package\\|Source\\):\\s-*\\([-a-zA-Z0-9+.]+?\\)\\s-*$")
	  (push (concat
		 (if (save-match-data (string-match "Source" (match-string 1)))
		     "src:"
		   "")
		 (match-string-no-properties 2)) result))
	(forward-line 1)))
    result))

(defun debian-control-view-package-bugs (package)
  "View bugs for package PACKAGE via http://bugs.debian.org."
  (interactive
   (list
    (completing-read "View bugs for package: "
		     (mapcar #'(lambda (x) (cons x 0))
			     (debian-control-mode-bug-package-names))
		     nil t)))
  (browse-url (concat "http://bugs.debian.org/" package)))

(add-to-list 'auto-mode-alist '("/debian/control\\'" . debian-control-mode))
;;;###autoload(add-to-list 'auto-mode-alist '("/debian/control\\'" . debian-control-mode))

(provide 'debian-control-mode)

;;; debian-control-mode.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/dpkg-dev-el/dpkg-dev-el.el0000775000000000000000000000704012230377265020652 0ustar  ;;; dpkg-dev-el.el --- startup file for the debian-el package

;;; Commentary:
;; 
;; This file is loaded from /etc/emacs/site-start.d/50dpkg-dev-el.el 

;;; History:
;;
;; 2003-11-03 - Peter Galbraith
;;  - Created.

;;; Code:

(defgroup dpkg-dev-el nil
  "Emacs helpers specific to Debian development."
  :group 'convenience)

(require 'dpkg-dev-el-loaddefs)

;; debian-bts-control
(defgroup debian-bts-control nil
  "Create messages for Debian BTS control interface"
  :group 'debian-bug
;;:link '(custom-manual "(dpkg-dev-el)debian-bts-control")
  :load 'debian-bts-control
  :group 'dpkg-dev-el)

;; debian-changelog-mode
(defgroup debian-changelog nil "Debian changelog maintenance"
  :group 'tools
  :prefix "debian-changelog-"
;;:link '(custom-manual "(dpkg-dev-el)debian-changelog-mode")
  :load 'debian-changelog-mode
  :group 'dpkg-dev-el)

;; debian-control-mode
(defgroup debian-control nil "Debian control file maintenance"
  :link '(url-link "http://cvs.verbum.org/debian/debian-control-mode")
  :group 'tools
;;:link '(custom-manual "(dpkg-dev-el)debian-control-mode")
  :load 'debian-control-mode
  :group 'dpkg-dev-el)

;; debian-copyright
(defgroup debian-copyright nil "Debian copyright mode"
  :group 'tools
  :prefix "debian-copyright-"
;;:link '(custom-manual "(dpkg-dev-el)debian-copyright")
  :load 'debian-copyright
  :group 'dpkg-dev-el)

;; readme-debian
(defgroup readme-debian nil "Readme Debian (mode)"
  :group 'tools
  :prefix "readme-debian-"
;;:link '(custom-manual "(dpkg-dev-el)readme-debian")
  :load 'readme-debian
  :group 'dpkg-dev-el)




;; other useful automode
(add-to-list 'auto-mode-alist
             '("/debian/[^/]*emacsen-startup\\'" . emacs-lisp-mode))
;; Closes #490292 
(add-to-list 'auto-mode-alist '("README.source" . readme-debian-mode))

(when (member 'utf-8 (coding-system-list))
  ;; default to utf-8 for debian changelog files
  (modify-coding-system-alist 'file "/changelog\\.Debian\\'" 'utf-8)
  (modify-coding-system-alist 'file "/debian/control\\'" 'utf-8)

;;; (modify-coding-system-alist 'file "/debian/changelog\\'" 'utf-8)
;;; -
;;; Kevin Ryde  (Closes: #587921)
;;;
;;; Instead use this for dh_installchangelog debian/packagename.changelog
;;; files too.  See http://bugs.debian.org/457047 by Trent W. Buck
;;; But not [:lower:][:digit:] since those forms are not available in xemacs21.
;;; xemacs21 can have utf-8 at startup if you use mule-ucs with
;;; DEB_MULEUCS_UNICODE=yes
  (modify-coding-system-alist 'file "/debian/\\([a-z0-9.+-]+\\.\\)?changelog\\'" 'utf-8)

  ;; Handle Debian native package, from Kevin Ryde in bug #317597 and #416218
  (defun debian-changelog-coding-system (args)
      "Return the coding system for a /usr/share/doc/[package]/changelog file.
If [package] is a debian native (no separate changelog.Debian) then answer
`utf-8', otherwise remove ourselves from `file-coding-system-alist' and see
what other rules say."
      (let ((filename (if (consp (cadr args))
                          (car (cadr args)) ;; ("filename" . buffer) in emacs 22
                        (cadr args)))       ;; "filename" in emacs 21
            (dirname  (file-name-directory filename)))
        (if (file-exists-p (concat dirname "changelog.Debian.gz"))
            (let ((file-coding-system-alist
                   (remove '("/usr/share/doc/[^/]+/changelog\\'"
                             . debian-changelog-coding-system)
                           file-coding-system-alist)))
              (apply 'find-operation-coding-system args))
          'utf-8))))


(provide 'dpkg-dev-el)

;;; dpkg-dev-el.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/dpkg-dev-el/debian-changelog-mode.el0000775000000000000000000023233112243644073022645 0ustar  ;;; debian-changelog-mode.el --- major mode for Debian changelog files.

;; Copyright (C) 1996 Ian Jackson
;; Copyright (C) 1997 Klee Dienes
;; Copyright (C) 1999 Chris Waters
;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Peter S Galbraith
;; Copyright (C) 2006, 2007, 2009, 2010 Peter S Galbraith
;;
;; This file 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 2, or (at your option)
;; any later version.
;;
;; debian-changelog-mode.el 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 your Debian installation, in /usr/share/common-licenses/GPL
;; If not, write to the Free Software Foundation, 51 Franklin Street,
;; Suite 500 Boston, MA 02110-1335, USA 

;;; Commentary:
;;
;; This is a major mode for Debian changelog files.  The main features
;; are:
;;
;;  - fontification (varies with upload urgency, etc).
;;  - create a entry for a new version (guessing the version number).
;;  - finalize a version with proper timestamp and syntax.
;;  - add an entry from another file in the source package.
;;  - interface with `debian-bug' to fetch list of bugs from the web,
;;    read a bug report via browse-url or as email, close a bug with
;;    thanks.
;;  - closed bugs are fontified and clickable to view them via browse-url.
;;
;; The mode is entered automatically when editing a debian/changelog file.
;; See the menus "Bugs" and "Changelog" for commands or do `C-h m' to get
;; the list of keybindings.
;;
;; From other files in unpacked sources, do `M-x debian-changelog-add-entry'
;; to add an entry for that file in the changelog file.

;;; History
;;
;; V1.00 30aug00  Peter S Galbraith 
;;  -  Prior version had no changelogs; starting one now.
;;     This is the potato version plus extensions by Chris Waters (easymenu;
;;     better menus, font-lock support).
;; V1.01 30aug00  Peter S Galbraith 
;;  - debian-changelog-finalise-last-version: Use XEmacs' (user-mail-address)
;;    function if variable user-mail-address is undefined.
;;    Thanks to Robert Bihlmeyer , closes Bug#61524
;;  - debian-changelog-finalise-last-version: Takes account of some env vars
;;    Thanks to Rafael Laboissiere , closes Bug#61226
;;  - debian-changelog-close-bug:  new command.
;; V1.02 23Feb01  Peter S Galbraith 
;;  - Added `debian-changelog-suggest-version', a mechanisn for guessing
;;    what the new version number should be.
;;    Closes half of Bug#85412
;; V1.03 23Feb01  Peter S Galbraith 
;;  - Fixed `fill-paragraph' by tweaks to paragraph-start and
;;    paragraph-separate variables.
;;    Closes second half of Bug#85412
;; V1.04 23Feb01  Peter S Galbraith 
;;  - Added `debian-changelog-web-bugs' `debian-changelog-web-packages'
;;    `debian-changelog-web-package'
;; V1.05 23Feb01  Peter S Galbraith 
;;  - made `debian-changelog-suggest-package-name' more picky about finding
;;    an acceptable name.
;; V1.06 28Feb01  Peter S Galbraith 
;;  - Create customizable variables debian-changelog-full-name and
;;    debian-changelog-mailing-address.
;;  - Make debian-changelog-finalise-last-version use them.
;; V1.07 28Feb01  Peter S Galbraith 
;;  - debian-changelog-suggest-version: Handle epochs!
;;    closes: Bug#87964: dpkg-dev-el: does wrong things with epochs
;; V1.08 07Mar01  Peter S Galbraith 
;;    debian-changelog-suggest-version: Handle package names with hyphens!
;;    closes: #88589 and #88245
;; V1.09 09Mar01  Peter S Galbraith 
;;    debian-changelog-suggest-version: better regexps for version numbers
;;    Created debian-changelog-increment-version
;; V1.10 10Mar01  Peter S Galbraith 
;;    tweaks docs for debian-changelog-mode function concerning
;;    add-log-mailing-address (now obsolete).
;; V1.11 24Apr01  Peter S Galbraith 
;;    Add stuff to try to trim out obsolete "Local Variables:" block from
;;    changelog files.
;; V1.12 24Apr01  Peter S Galbraith 
;;    Modify font-lock code. closes: #93243
;; V1.13 27Apr01  Peter S Galbraith 
;;    Move code concerning local variables near beginning of file such that
;;    `hack-local-variables' doesn't complain.
;; V1.14 30Apr01  Peter S Galbraith 
;;    Add `critical' bug severity (see http://bugs.debian.org/94475)
;; V1.15 30Apr01  Peter S Galbraith 
;;    Tweak font-locking bug number regexp to match dpkg-parsechangelog 1.9.1
;; V1.16 30Apr01  Peter S Galbraith 
;;    Added debian-changelog-web-bug (will bound to a mouse button later)
;; V1.17 30Apr01  Peter S Galbraith 
;;    debian-changelog-increment-version: Handle 3.5.4.0 case (single digits)
;;    closes: #95831
;; V1.18 30Apr01  Peter S Galbraith 
;;    Add mouse interface to web-bug (with green highlight).
;; V1.19 01May01  Peter S Galbraith 
;;    Add imenu support as `History'.  Bug: The history menu is empty when
;;    point is on the (mouse-highlighted) bug number (using emacs-20.7).
;; V1.20 02May01  Peter S Galbraith 
;;    Leave `mode: debian-changelog-mode' alone for native packages.
;; V1.21 02May01  Peter S Galbraith 
;;    Fix empty History menu when on bug numbers.
;; V1.22 02May01  Peter S Galbraith 
;;    Fontify version number (e.g. NMU in warning-face)
;; V1.23 02May01  Peter S Galbraith 
;;    Bypass imenu-progress-message because it breaks byte-compilation (?)
;; V1.24 03May01  Peter S Galbraith 
;;    Correct fix for imenu-progress-message macro (can't rely on variable
;;    defined here for loading of imenu during byte-compilation).
;; V1.25 04May01  Peter S Galbraith 
;;    Add `experimental' distribution.
;; V1.26 04May01  Peter S Galbraith 
;;    Web site changed the URL for package searches:
;;    http://cgi.debian.org/cgi-bin -> http://packages.debian.org/cgi-bin
;; V1.27 04May01  Peter S Galbraith 
;;    Set new version to `experimental' when last one was set to that.
;;    closes: #96260: Default to the same distribution as the previous release
;; V1.28 04May01  Peter S Galbraith 
;;    Make `set-distribution' and `set-urgency' unavailable when changelog
;;    is finalised (error at command line and menu grayed-out).
;; V1.29 04May01  Peter S Galbraith 
;;    Add-to auto-mode-alist in case not using dpkg-dev-el package.
;; V1.30 09May01  Peter S Galbraith 
;;    Fixed brain-damaged auto-mode-alist added in V1.29 (*blush*).
;; V1.31 28May01  Peter S Galbraith 
;;    Fix typo (closes: #98577).
;;    Add a message display after each call to browse-url.
;; V1.32 28May01  Peter S Galbraith 
;;  - XEmacs21's easy-menu-define doesn't like :active.
;;  - XEmacs21 need easy-menu-add call in mode setup.
;;  - debian-changelog-setheadervalue: check at this lower level if finalised.
;; V1.33 29May01  Peter S Galbraith 
;;    Fix History IMenu for XEmacs21 (it doesn't autoload
;;    match-string-no-properties).
;; V1.34 29May01  Peter S Galbraith 
;;  - debian-changelog-fontify-version: allow version numbers with many hyphens
;;  - debian-changelog-suggest-version: heavy changes to deal with many hyphens
;; V1.35 06Jun01 Peter S Galbraith 
;;  - patch from Brian Warner  to make
;;    debian-changelog-local-variables-maybe-remove-done really buffer-local.
;;  - Change another occurrence of make-local-variable.
;; V1.36 11Jun01 Peter S Galbraith 
;;    changed urgency "critical" to "emergency".
;;    See http://lists.debian.org/debian-policy-0106/msg00095.html
;; V1.37 11Jun01 Peter S Galbraith 
;;    debian-changelog-suggest-version: another tweak when upstream version
;;    number contains hyphens (closes: #100162).
;; V1.38 13Jun01 Peter S Galbraith 
;;    debian-changelog-suggest-version: peppered regexp-quote at various places
;;    to match package names and version that contain regexp characters.
;; V1.39 13Jun01 Peter S Galbraith 
;;    change (provide 'debian-changelog) to (provide 'debian-changelog-mode)
;;    (closes: #100639)  Thanks *again* Yann Dirson!
;; V1.40 22Jun01 Peter S Galbraith 
;;    Changed urgency "emergency" back to "critical" (!)
;;    See http://lists.debian.org/debian-policy-0106/msg00240.html
;; V1.41 04Jul01 Peter S Galbraith 
;;    debian-changelog-finalised-p updated by Tommi Virtanen 
;;    (closes: #102088)
;; V1.42 10Jul01 Peter S Galbraith 
;;    debian-changelog-finalised-p: tweak regexp (really closes: #102088)
;; V1.43 25Jul01 Peter S Galbraith 
;;    font-lock enforces 2 space exactly between email and date.
;; V1.44 26Jul01 Peter S Galbraith 
;;     No conditions left to keep variable block (See bug #105889)
;;     - Removed debian-changelog-package-native-p function.
;;     - Removed debian-changelog-local-variables-email-p function.
;;     - Removed debian-changelog-local-variables-remove-address function.
;;     - Removed debian-changelog-local-variables-remove-mode function.
;;     - Created debian-changelog-local-variables-remove function.
;; V1.45 15Aug01 Peter S Galbraith 
;;    Bug list menu added (via wget).
;; V1.46 15Aug01 Roland Mas 
;;    One-character tweak to package name font-lock regexp.
;; V1.47 15Aug01 Peter S Galbraith 
;;    debian-changelog-web-bug: bug fix when called from menu
;; V1.48 19Sep01 Brian Warner 
;;  - move to end of file before prompting for removal of local variables.
;;  - remove global def of debian-changelog-local-variables-maybe-remove-done.
;; V1.49 22Nov01 Roland Mas 
;;    debian-changelog-suggest-version: tweak regexp for case of upstream
;;    version number with a single character.
;; V1.50 30Nov01 Roland Mas 
;;    replaced debian-changelog.el by debian-changelog-mode.el
;; V1.51 24Jan02 Peter S Galbraith 
;;    debian-changelog-web-bugs: return all bugs for the source package.
;; V1.52 07Feb02 Peter S Galbraith 
;;    debian-changelog-build-bug-menu: return all bugs for the source package.
;; V1.53 13May02 Peter S Galbraith 
;;    debian-changelog-mode:  Add call to hack-local-variables since the "Local
;;    variables:" block wasn't parsed otherwise.  Strange.
;; V1.54 29May02 Peter S Galbraith 
;;    s/font-latex-warning-face/debian-changelog-warning-face/
;;    Now that was a weird leftover from cut/paste!
;; V1.55 03June02 Peter S Galbraith 
;;    fontify woody-proposed-updates as frozen.
;; V1.56 25July02 Peter S Galbraith 
;;    debian-changelog-mode: Remove call to hack-local-variables added in V1.53
;;    since a "mode: debian-changelog" setting created an infinite loop.
;;    The bug I attemped to fix in V1.53 occurred when debian-changelog-mode
;;    was invoked using the debian-changelog-find-file-hook mecanism in
;;    50dpkg-dev-el.el.  This invoked debian-changelog-mode which called
;;    kill-all-local-variables, deleting our settings.  To get around this, I
;;    no longer call 'text-mode' and copied whatever setting we need from it
;;    (because it also kill-all-local-variables).
;;    closes: #153982.
;; V1.57 29July02 Peter S Galbraith 
;;    debian-changelog-mode: Reinsert kill-all-local-variables removed in
;;    last version.  It's used by font-lock-mode to turn on font-lock-mode
;;    when global-font-lock-mode is used.  Since this kills the Local
;;    Variables, the mode can no longer be entered late in the game as was
;;    done in 50dpkg-dev-el.el by a find-file-hooks.  Instead, use a
;;    change-log-mode-hook which is less intrusive anyway.
;; V1.58 29July02 Peter S Galbraith 
;;    debian-changelog-greater-than: new function to determine if a version
;;    number is greater than another.  Used it to incorporate some logic
;;    for for better guessing of new version numbers for native packages to
;;    fix bug #113964.
;; V1.59 02Aug2002 Peter S Galbraith 
;;    Remove a bunch of code duplicated in debian-bug.el and load that file
;;    instead.
;;     debian-changelog-web-bugs -> debian-bug-web-bugs
;;     debian-changelog-web-bug  -> debian-bug-web-bug
;;     debian-changelog-web-packages -> debian-bug-web-packages
;;     debian-changelog-web-package  -> debian-bug-web-package
;;    dpkg-dev-el package should depend on versioned debbugs-el.
;; V1.60 15Aug2002 Peter S Galbraith 
;;    Update list of possible distributions to upload to from list given
;;    from http://bugs.debian.org/150466  (Closes: #156762)
;; V1.61 20Aug2002 Peter S Galbraith 
;;    Prompt for confirmation and give *big* warning if user wants to set
;;    the upload distribution to a -security one.  See discussion on
;;    http://bugs.debian.org/150466
;; V1.62 20Aug2002 Peter S Galbraith 
;; V1.63 05Sep2002 Peter S Galbraith 
;;    Fontify bugs on multiple-line closes: statements.  Patch from
;;    Frdric Bothamy.  (Closes: #159041)
;; V1.64 05Sep2002 Peter S Galbraith 
;;    debian-changelog-suggest-version fix (Closes: #159643)
;; V1.65 05Sep2002 Peter S Galbraith 
;;  - Stupid bug fix.  s/debian-bug-bug-alist/debian-bug-alist/.
;;  - Bug closing regexp enhancement from Roland Mas.
;; V1.66 24Oct2002 Peter S Galbraith 
;;  - Add UNRELEASED distribution, patch from Junichi Uekawa
;;     with additional menu entry (Closes: #166163).
;;    See bug #164470 for relevance and usage of UNRELEASED distribution.
;; V1.67 14Apr2003 Peter S Galbraith 
;;  - Use debian-bug.el's debian-bug-open-alist (needs emacs-goodies-el 19.4)
;; V1.68 21Apr2003 Peter S Galbraith 
;;    Byte-compilation cleanup.
;; V1.69 27Apr2003 Peter S Galbraith 
;;  - defcustom debian-changelog-mode-hook added.  (Closes: #190853)
;;  - debian-changelog-add-version creates new version in empty file
;;    (Closes: #191285)
;; V1.70 28May2003 Peter S Galbraith 
;;  - Define (really) match-string-no-properties for XEmacs (Closes: #195181)
;; V1.71 02Sep2003 Peter S Galbraith 
;;  - When closing a bug, insert bug title and thanks if bug info was
;;    downloaded from the web.
;; V1.72 17Sep2003 Peter S Galbraith 
;;  - Added browse-url link to `Best Practices for debian/changelog' in menu.
;; V1.73 04Nov2003 Peter S Galbraith 
;;  - checkdoc fixed (not complete!)
;;  - Add autoload tag.
;; V1.74 22Nov2003 Peter S Galbraith 
;;  - Make `debian-changelog-add-entry' works from files in unpacked sources.
;;    Thanks to Junichi Uekawa for suggesting it (Closes: #220641)
;; V1.75 27Nov2003 Peter S Galbraith 
;;  - Add menu entry for "Archived Bugs for This Package", for
;;    "Developer Page for This Package" and
;;    "Developer Page for This Maintainer".
;;  - Added function `debian-changelog-maintainer' and interactive command
;;    `debian-changelog-web-developer-page'.
;; V1.76 17Dec2003 Peter S Galbraith 
;;  - debian-changelog-setdistribution: Use `should-use-dialog-box-p' on XEmacs
;;    (Closes: #224187)
;; V1.77 19Feb2004 Peter S Galbraith 
;;  - Add file NEWS.Debian to auto-mode-alist.  Thanks to Chris Lawrence
;;    for suggesting it.  (Closes: #233310)
;; V1.78 14Apr2004 Peter S Galbraith 
;;  - debian-changelog-setdistribution: Dismiss warning window when setting
;;    distribution to security.  Thanks to Martin Schulze (Closes: #234730)
;;  - Should mark line beginning with a tab as invalid. Fontified in warning
;;    face.  Thanks to Michel Daenzer (Closes: #235310).
;; V1.79 07June2005 Jari Aalto 
;;  - fix byte-compilation warning about
;;    `(fboundp (quote imenu))' called for effect (Closes: #309788)
;; V1.80 15Sep2005   Rafael Laboissiere 
;;  - Add debian-changelog-add-version-hook defaulting to
;;    debian-changelog-add-new-upstream-release (Closes: #296725)
;; V1.81 19Sep2005 Peter S Galbraith 
;;  - Add outline-regexp and C-cC-n and C-cC-p movement commands as
;;    suggested by Romain Francoise  (Closes: #322994)
;; V1.82 05Sep2006 Peter Samuelson 
;;  - Add tilde support for upstream version numbers (Closes: #382514)
;; V1.83 11Oct2006 Luca Capello 
;;  - Rename `debian-changelog-maintainer' to `debian-changelog-last-maintainer',
;;    this is what the function really work on
;;  - `debian-changelog-last-maintainer' now returns a list of "(NAME EMAIL)"
;;    and not only EMAIL
;;  - Add `debian-changelog-comaintainer-insert', which actually inserts the
;;    co-maintainer name in the form "[ NAME ]"
;;  - Add `debian-changelog-comaintainer', which checks if we're in a
;;    co-maintenance, calling `debian-changelog-comaintainer-insert'
;;  - Add co-maintenance support to `debian-changelog-unfinalise-last-version'
;; V1.84 14May2007 Peter S Galbraith 
;;  - Use "date -R" instead of deprecated "822-date"
;;    (Closes: #423142, #423155, #423828) 
;;  - Tighter regexp for finalisation string
;; V1.85 25Jul2007 Peter S Galbraith 
;;  - Adapt patch from Luca Capello  for bug #431091
;; V1.86 08Aug2007 Peter S Galbraith 
;;  - auto-mode-alist  for "/debian/*NEWS" files (Closes: #424779)
;; V1.87 02Sep2007 Peter S Galbraith 
;;  - Implement pacakge lookup on http://packages.debian.org/
;;    See http://bugs.debian.org/87725
;;  - Patch from Luca Capello  to add keys to generate the
;;    open bug alist.
;; V1.88 12Apr2008 Trent W. Buck 
;;  - Generalize auto-mode-alist entry.
;;    See http://bugs.debian.org/457047
;; V1.89 23Feb2009 Jari.aalto@cante.net
;;  - finalize date in UTC (User configurable) (Closes: #503700)
;; V1.90 24Oct2009 Rafael Laboissiere 
;;  - debian-changelog-close-bug does not work properly under XEmacs 21.4.21
;;    because the arguments passed to replace-in-string in the inline function
;;    debian-chagelog--rris are in the wrong order. Closes: #476271
;; V1.91 12Nov2009 Peter S Galbraith 
;;    Updated URL for "Best practices".
;; V1.92 27Apr2010 Peter S Galbraith 
;;    Invoke `debian-bug-build-bug-menu' with SOURCE arg set to t.
;;    Needs debian-el 33.2
;; V1.93 10May2010 Peter S Galbraith 
;;    Fix typo (Closes: #580818)
;; V1.94 28Jul2010 Kevin Ryde 
;;    Simplify auto-mode-alist (Closes: #587924)
;;
;;; Acknowledgements:  (These people have contributed)
;;   Roland Rosenfeld 
;;   James LewisMoss 
;;   Rafael Laboissiere 
;;   Brian Warner 
;;   Yann Dirson 

;;; Code:

(defgroup debian-changelog nil "Debian changelog maintenance"
  :group 'tools
  :prefix "debian-changelog-")

(defgroup debian-changelog-faces nil
  "Faces for fontifying text in debian-changelog."
  :prefix "debian-changelog-"
  :group 'debian-changelog)

(defcustom debian-changelog-full-name (or (getenv "DEBFULLNAME")
                                          (user-full-name))
  "*Full name of user, for inclusion in Debian changelog headers.
This defaults to the contents of environment variable DEBFULLNAME
or else to the value returned by the function `user-full-name'."
  :group 'debian-changelog
  :type 'string)

(defcustom debian-changelog-mailing-address
  (or (getenv "DEBEMAIL")
      (getenv "EMAIL")
      (and (boundp 'user-mail-address) user-mail-address)
      (and (fboundp 'user-mail-address) (user-mail-address)))
  "*Electronic mail address of user, for inclusion in Debian changelog headers.
This defaults to the value of (in order of precedence):
 Contents of environment variable DEBEMAIL,
 Contents of environment variable EMAIL,
 Value of `user-mail-address' variable,
 Value returned by the `user-mail-address' function."
  :group 'debian-changelog
  :type 'string)

(defcustom debian-changelog-allowed-distributions
  '("unstable"
    "testing"
    "testing-security"
    "stable" 
    "stable-security" 
    "oldstable-security" 
    "experimental" 
    "hardy"
    "lucid"
    "oneiric"
    "precise"
    "quantal"
    "raring"
    "saucy"
    "trusty"
    "UNRELEASED" )
  "*Allowed values for distribution."
  :group 'debian-changelog
  :type '(repeat string))

(defcustom debian-changelog-local-variables-maybe-remove t
  "*Ask to remove obsolete \"Local Variables:\" block from changelog.
This is done only under certain conditions."
  :group 'debian-changelog
  :type 'boolean)

(defcustom debian-changelog-highlight-mouse-t t
  "*Use special overlay for bug numbers, defining mouse-3 to web interface."
  :group 'debian-changelog
  :type 'boolean)

(defcustom debian-changelog-use-imenu (fboundp 'imenu-add-to-menubar)
  "*Use imenu package for debian-changelog-mode?
If you do not wish this behaviour, reset it in your .emacs file like so:

  (setq debian-changelog-use-imenu nil)"
  :group 'debian-changelog
  :type 'boolean)

;; This solves the consistency problem with `debian-changelog-close-bug'
;; as per bug #431091
(defcustom debian-changelog-close-bug-statement "(Closes: #%s)."
  "The text to be inserted to close a bug.  `%s' is replaced by
the bug number."
  :group 'debian-changelog
  :type 'string)

(defcustom debian-changelog-mode-hook nil
  "Normal hook run when entering Debian Changelog mode."
  :group 'debian-changelog
  :type 'hook
  :options '(turn-on-auto-fill flyspell-mode))

(defcustom debian-changelog-add-version-hook
  (list 'debian-changelog-add-new-upstream-release)
  "Hooks run just before inserting the signature separator \"--\" in a 
new version in debian/changelog."
  :group 'debian-changelog
  :type 'hook)

(defcustom debian-changelog-date-utc-flag nil
  "If non-nil, return date string in UTC when finalizing entry.
See function `debian-changelog-date-string'."
  :group 'debian-changelog
  :type 'boolean)

;; This function is from emacs/lisp/calendar/icalendar.el,
;; necessary to replace "%s" with the bug number in
;; `debian-changelog-close-bug-statement'
(defsubst debian-changelog--rris (&rest args)
  "Replace regular expression in string.
Pass ARGS to `replace-regexp-in-string' (GNU Emacs) or to
`replace-in-string' (XEmacs)."
  ;; XEmacs:
  (if (fboundp 'replace-in-string)
      (save-match-data ;; apparently XEmacs needs save-match-data
        ;; and arguments are in different order.
        ;; Patch from Rafael Laboissiere 
        ;; Closes: #476271
        (apply 'replace-in-string (list (nth 2 args) (nth 0 args) (nth 1 args))))
    ;; Emacs:
    (apply 'replace-regexp-in-string args)))

(defvar debian-changelog-local-variables-maybe-remove-done nil
  "Internal flag so we prompt only once.")

(autoload 'debian-bug-web-bug "debian-bug")
(autoload 'debian-bug-web-bugs "debian-bug")
(autoload 'debian-bug-web-packages "debian-bug")
(autoload 'debian-bug-web-package "debian-bug")
(autoload 'debian-bug-bug-menu-init "debian-bug")
(autoload 'debian-bug-web-this-bug-under-mouse "debian-bug")
(autoload 'debian-bug-web-developer-page "debian-bug")
(defvar debian-bug-open-alist)


(require 'add-log)
(require 'easymenu)
(eval-when-compile
  (require 'cl))

;; XEmacs21.1 compatibility -- from XEmacs's apel/poe.el
(unless (fboundp 'match-string-no-properties)
  (defun match-string-no-properties (num &optional string)
    "Return string of text matched by last search, without text properties.
NUM specifies which parenthesized expression in the last regexp.
 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
Zero means the entire text matched by the whole regexp or whole string.
STRING should be given if the last search was by `string-match' on STRING."
    (if (match-beginning num)
        (if string
            (let ((result
                   (substring string (match-beginning num) (match-end num))))
              (set-text-properties 0 (length result) nil result)
              result)
          (buffer-substring-no-properties (match-beginning num)
                                          (match-end num))))))
;;
;; Clean up old "Local Variables:" entries
;; Peter Galbraith

;; **Important note**
;;
;;  If we get the following warning:
;;
;;   File local-variables error: (error "Local variables entry is missing the prefix")
;;
;;  when installing the dpkg-dev-el package, it's because the command
;;  (hack-local-variables) from files.el is bailing on all the "Local
;;  Variables:" strings in this file.  The simplest solution is to keep all
;;  occurrences of this string before the last 3000 characters of the file,
;;  where `hack-local-variables' starts looking:

;; First, I made the add-log-mailing-address variable obsolete but still
;; left the "mode:" line in the variable block for Debian native packages
;; because it was impossible to tell what they were from the installed
;; changelog.gz name.  In bug #105889, I came up with code to stick in
;; /etc/emacs/site-start.d/50dpkg-dev-el.el to figure that out in a
;; find-file-hooks hook.  So now the variable block is completely obsolete.
(defun debian-changelog-local-variables-maybe-remove ()
  "Ask to remove local variables block if buffer not read-only."
  (interactive)
  (if (or debian-changelog-local-variables-maybe-remove-done
          buffer-read-only)
      nil
    (setq debian-changelog-local-variables-maybe-remove-done t)
    (if (debian-changelog-local-variables-exists-p)
	(save-excursion
	  (goto-char (point-max)) ; local vars are always at end
	  (if (yes-or-no-p
	       "Remove obsolete \"local variables:\" from changelog? ")
	      (debian-changelog-local-variables-remove))))))

(defun debian-changelog-local-variables-exists-p ()
  "Return t if package has a \"Local Variables:\" block."
  (save-excursion
    (let ((case-fold-search t))
      (goto-char (point-max))
      (and (re-search-backward "^local variables:" nil t)
           (or (re-search-forward "add-log-mailing-address:" nil t)
               (re-search-forward "mode: debian-changelog" nil t))))))

(defun debian-changelog-local-variables-remove ()
  "Remove `add-log-mailing-address' entry from local variables block."
  (save-excursion
    (let ((case-fold-search t))
      (goto-char (point-max))
      ;; Remove add-log-mailing-address: line if it exists
      (if (and (re-search-backward "^local variables:" nil t)
	       (re-search-forward "add-log-mailing-address: .+\n" nil t))
          (delete-region (match-beginning 0)(match-end 0)))
      (goto-char (point-max))
      ;; Remove "mode: debian-changelog" line if it exists
      (if (and (re-search-backward "^local variables:" nil t)
	       (re-search-forward "mode: debian-changelog.*\n" nil t))
          (delete-region (match-beginning 0)(match-end 0)))
      (goto-char (point-max))
      ;; Remove empty variable block if it exists
      (if (re-search-backward "^local variables: *\nend:" nil t)
          (delete-region (match-beginning 0)(match-end 0))))))

;;
;; internal functions: getheadervalue and setheadervalue both use a
;; regexp to probe the changelog entry for specific fields.

;; warning: if used with a "re" that doesn't have at least one group,
;; the results will be unpredictable (to say the least).

(defun debian-changelog-setheadervalue (re str)
  (if (eq (debian-changelog-finalised-p) t)
      (error (substitute-command-keys "most recent version has been finalised - use \\[debian-changelog-unfinalise-last-version] or \\[debian-changelog-add-version]")))
  (let ((lineend (save-excursion (end-of-line)(point))))
    (save-excursion
      (goto-char (point-min))
      (if (re-search-forward re lineend t)
	  (let ((a (match-beginning 1))
		(b (match-end 1)))
	    (goto-char a)
	    (delete-region a b)
	    (insert str))))))

(defun debian-changelog-getheadervalue (re)
  (let ((lineend (save-excursion (end-of-line) (point))))
    (save-excursion
      (goto-char (point-min))
      (re-search-forward re lineend)
      (buffer-substring-no-properties (match-beginning 1) (match-end 1)))))

;;
;; some get/set functions for specific fields
;;  (Chris Waters)

(defun debian-changelog-seturgency (val)
  (debian-changelog-setheadervalue "\\;[^\n]* urgency=\\(\\sw+\\)" val))
(defun debian-changelog-geturgency ()
  (debian-changelog-getheadervalue "\\;[^\n]* urgency=\\(\\sw+\\)"))
(defun debian-changelog-getdistribution ()
  (debian-changelog-getheadervalue ") \\(.*\\)\\;"))
(defvar last-nonmenu-event)
(defun debian-changelog-setdistribution (val)
  (if (not (string-match "^.*security" val))
      (debian-changelog-setheadervalue ") \\(.*\\)\\;" val)
    (cond
     ((or (and (fboundp 'should-use-dialog-box-p)
               (should-use-dialog-box-p))
          (and window-system
               (equal last-nonmenu-event '(menu-bar))
               use-dialog-box))
      (if (y-or-n-p
           (concat
            "Warning, although the {oldstable,stable,testing}-security
distribution exists it should not be used unless you are a
member of the security team.  Please don't upload to it if you
are not 150% sure that your package is suitable.  In case of
doubt, please send the files to team@security.debian.org via
mail instead.

Upload to " val  " anyway?"))
          (debian-changelog-setheadervalue ") \\(.*\\)\\;" val)))
     (t
      (let ((window-config (current-window-configuration)))
        (with-output-to-temp-buffer "*Help*"
          (princ (concat
                  "Warning, although the {oldstable,stable,testing}-security
distribution exists it should not be used unless you are a
member of the security team.  Please don't upload to it if you
are not 150% sure that your package is suitable.  In case of
doubt, please send the files to team@security.debian.org via
mail instead.

Upload to " val  " anyway?")))
        (if (y-or-n-p (format "Upload to %s anyway? " val))
            (debian-changelog-setheadervalue ") \\(.*\\)\\;" val))
        (set-window-configuration window-config))))))

;;
;; keymap table definition
;;

(autoload 'outline-next-visible-heading "outline")
(autoload 'outline-prev-visible-heading "outline")

(defvar debian-changelog-mode-map nil
  "Keymap for Debian changelog major mode.")
(if debian-changelog-mode-map
    nil
  (setq debian-changelog-mode-map (make-sparse-keymap))
  (define-key debian-changelog-mode-map "\C-c\C-a"
    'debian-changelog-add-entry)
  (define-key debian-changelog-mode-map "\C-c\C-o"
    'debian-changelog-build-open-bug-list)
  (define-key debian-changelog-mode-map "\C-c\C-b"
    'debian-changelog-close-bug)
  (define-key debian-changelog-mode-map "\C-c\C-f"
    'debian-changelog-finalise-last-version)
  (define-key debian-changelog-mode-map "\C-c\C-c"
    'debian-changelog-finalise-and-save)
  (define-key debian-changelog-mode-map "\C-c\C-v"
    'debian-changelog-add-version)
  (define-key debian-changelog-mode-map "\C-c\C-d"
    'debian-changelog-distribution)
  (define-key debian-changelog-mode-map "\C-c\C-u"
    'debian-changelog-urgency)
  (define-key debian-changelog-mode-map "\C-c\C-e"
    'debian-changelog-unfinalise-last-version)
  (define-key debian-changelog-mode-map "\C-c\C-n"
    'outline-next-visible-heading)
  (define-key debian-changelog-mode-map "\C-c\C-p"
    'outline-previous-visible-heading))
 

;;
;; menu definition (Chris Waters)
;;

(defvar debian-changelog-is-XEmacs
  (and
   (not (null (save-match-data (string-match "XEmacs\\|Lucid" emacs-version))))
   (= 21 emacs-major-version)))

(cond
 (debian-changelog-is-XEmacs
(easy-menu-define
 debian-changelog-menu debian-changelog-mode-map "Debian Changelog Mode Menu"
 '("Changelog"
   ["New Version" debian-changelog-add-version (debian-changelog-finalised-p)]
   ["Add Entry" debian-changelog-add-entry
    (not (debian-changelog-finalised-p))]
   ["Build Open Bug List" debian-changelog-build-open-bug-list]
   ["Close Bug" debian-changelog-close-bug
    (not (debian-changelog-finalised-p))]
   "--"
   ("Set Distribution"
    ["unstable" (debian-changelog-setdistribution "unstable") t]
    ("--")
    ["testing" (debian-changelog-setdistribution "testing") t]
    ["testing-security" (debian-changelog-setdistribution "testing-security") t]
    ("--")
    ["stable" (debian-changelog-setdistribution "stable") t]
    ["stable-security" (debian-changelog-setdistribution "stable-security") t]
    ["oldstable-security" (debian-changelog-setdistribution "oldstable-security") t]
    ("--")
    ["experimental" (debian-changelog-setdistribution "experimental") t]
    ["UNRELEASED" (debian-changelog-setdistribution "UNRELEASED") t])
   ("Set Urgency"
    ["low" (debian-changelog-seturgency "low") t]
    ["medium" (debian-changelog-seturgency "medium") t]
    ["high" (debian-changelog-seturgency "high") t]
    ["critical" (debian-changelog-seturgency "critical") t])
   "--"
   ["Unfinalise" debian-changelog-unfinalise-last-version
    (debian-changelog-finalised-p)]
   ["Finalise" debian-changelog-finalise-last-version
    (not (debian-changelog-finalised-p))]
   ["Finalise+Save" debian-changelog-finalise-and-save
    (not (debian-changelog-finalised-p))]
   "--"
   "Web View"
   ["Best Practices" (browse-url "http://www.debian.org/doc/developers-reference/best-pkging-practices.html#bpp-debian-changelog") t]
   ["Bugs for This Package" (debian-bug-web-bugs) t]
   ["Archived Bugs for This Package" (debian-bug-web-bugs t) t]
   ["Bug Number..." (debian-bug-web-bug) t]
   ["Package Info" (debian-bug-web-packages) t]
;; ("Package web pages..."
;;  ["stable" (debian-bug-web-package "stable") t]
;;  ["testing" (debian-bug-web-package "testing") t]
;;  ["unstable" (debian-bug-web-package "unstable") t])
   ["Developer Page for This Package" (debian-bug-web-developer-page) t]
   ["Developer Page for This Maintainer" (debian-changelog-web-developer-page)
    t]
   "--"
   ["Customize" (customize-group "debian-changelog") (fboundp 'customize-group)])))
 (t
(easy-menu-define
 debian-changelog-menu debian-changelog-mode-map "Debian Changelog Mode Menu"
 '("Changelog"
   ["New Version" debian-changelog-add-version (debian-changelog-finalised-p)]
   ["Add Entry" debian-changelog-add-entry
    (not (debian-changelog-finalised-p))]
   ["Build Open Bug List" debian-changelog-build-open-bug-list]
   ["Close Bug" debian-changelog-close-bug
    (not (debian-changelog-finalised-p))]
   "--"
   ("Set Distribution"     :active (not (debian-changelog-finalised-p))
    ["unstable" (debian-changelog-setdistribution "unstable") t]
    ("--")
    ["testing" (debian-changelog-setdistribution "testing") t]
    ["testing-security" (debian-changelog-setdistribution "testing-security") t]
    ("--")
    ["stable" (debian-changelog-setdistribution "stable") t]
    ["stable-security" (debian-changelog-setdistribution "stable-security") t]
    ["oldstable-security" (debian-changelog-setdistribution "oldstable-security") t]
    ("--")
    ["experimental" (debian-changelog-setdistribution "experimental") t]
    ["UNRELEASED" (debian-changelog-setdistribution "UNRELEASED") t])
   ("Set Urgency"     :active (not (debian-changelog-finalised-p))
    ["low" (debian-changelog-seturgency "low") t]
    ["medium" (debian-changelog-seturgency "medium") t]
    ["high" (debian-changelog-seturgency "high") t]
    ["critical" (debian-changelog-seturgency "critical") t])
   "--"
   ["Unfinalise" debian-changelog-unfinalise-last-version
    (debian-changelog-finalised-p)]
   ["Finalise" debian-changelog-finalise-last-version
    (not (debian-changelog-finalised-p))]
   ["Finalise+Save" debian-changelog-finalise-and-save
    (not (debian-changelog-finalised-p))]
   "--"
   "Web View"
   ["Best Practices" (browse-url "http://www.debian.org/doc/developers-reference/ch-best-pkging-practices.en.html#s-bpp-debian-changelog") t]
   ["Bugs for This Package" (debian-bug-web-bugs) t]
   ["Archived Bugs for This Package" (debian-bug-web-bugs t) t]
   ["Bug Number..." (debian-bug-web-bug) t]
   ["Package Info" (debian-bug-web-packages) t]
   ("Package web pages..."
    ["stable" (debian-bug-web-package "stable") t]
    ["testing" (debian-bug-web-package "testing") t]
    ["unstable" (debian-bug-web-package "unstable") t])
   ["Developer Page for This Package" (debian-bug-web-developer-page) t]
   ["Developer Page for This Maintainer" (debian-changelog-web-developer-page)
    t]
   "--"
   ["Customize" (customize-group "debian-changelog") (fboundp 'customize-group)]))))

;;
;; interactive function to add a new line to the changelog
;;

;;;###autoload
(defun debian-changelog-add-entry ()
  "Add a new change entry to a debian-style changelog.
If called from buffer other than a debian/changelog, this will search
for the debian/changelog file to add the entry to."
  (interactive)
  (if (string-match ".*/debian/changelog" (buffer-file-name))
      (debian-changelog-add-entry-plain)
    (debian-changelog-add-entry-file)))

(defun debian-changelog-add-entry-plain ()
  "Add a new change entry to a debian-style changelog."
  (if (eq (debian-changelog-finalised-p) t)
      (error (substitute-command-keys "most recent version has been finalised - use \\[debian-changelog-unfinalise-last-version] or \\[debian-changelog-add-version]")))
  (goto-char (point-min))
  (re-search-forward "\n --")
  (backward-char 5)
  (if (prog1 (looking-at "\n") (forward-char 1))
      nil
    (insert "\n"))
  (insert "  * ")
  (save-excursion (insert "\n")))

(defun debian-changelog-add-entry-file ()
  "Add an entry for current file in debian/changelog."
  (let* ((this-file (buffer-file-name))
         (directory (if (not this-file)
                        (error "This buffer has no file associated to it")
                      (directory-file-name (file-name-directory this-file))))
         (filename (file-name-nondirectory this-file))
         (success))
    (while directory
      (let ((changelog (expand-file-name "debian/changelog" directory)))
        (cond
         ((file-readable-p changelog)
          (debian-changelog-add-entry-file-specified changelog filename)
          (setq directory nil
                success t))
         (t
          (if (not (string-match "\\(.*\\)/\\([^/]+\\)$" directory))
              (setq directory nil)
            (setq filename (concat (match-string 2 directory) "/" filename)
                  directory (match-string 1 directory)))))))
    (if (not success)
        (error "debian directory not found"))))

(defun debian-changelog-add-entry-file-specified (changelog filename)
  "Insert an entry in debian CHANGELOG file for FILENAME."
  (interactive)
  (find-file changelog)
  (if (eq (debian-changelog-finalised-p) t)
      (let ((action (capitalize
                     (read-string
                      "Most recent version is finalised, [u]nfinalize or [a]dd new version? "))))
        (if (not (string-match "^[uU]" action))
            (debian-changelog-add-version)
          (debian-changelog-unfinalise-last-version)
          (debian-changelog-add-entry-plain)))
    (debian-changelog-add-entry-plain))
  (insert filename ": "))

;;
;; interactive function to close bugs by number. (Peter Galbraith)
;;

(defvar debian-changelog-close-bug-takes-arg t
  "A compatibility flag for debian-bug.el.")

(defun debian-changelog-build-open-bug-list ()
  "Generate open bugs list, i.e. `debian-bug-open-alist'."
  (interactive)
  (debian-bug-build-bug-menu (debian-changelog-suggest-package-name) t))

(defun debian-changelog-close-bug (bug-number)
  "Add a new change entry to close a BUG-NUMBER."
  (interactive
    (progn
      (if (eq (debian-changelog-finalised-p) t)
          (error (substitute-command-keys "most recent version has been finalised - use \\[debian-changelog-unfinalise-last-version] or \\[debian-changelog-add-version]")))
      (list (completing-read "Bug number to close: "
                             debian-bug-open-alist nil nil))))
  (if (not (string-match "^[0-9]+$" bug-number))
      (error "The bug number should consists of only digits"))
  (debian-changelog-add-entry)
  (cond
   ((and debian-bug-open-alist
         (assoc bug-number debian-bug-open-alist))
    (insert (cadr (assoc bug-number debian-bug-open-alist)))
    (fill-paragraph nil))
   (t
    (save-excursion
      (insert " " (debian-changelog--rris
		   "%s" bug-number debian-changelog-close-bug-statement)))
    (message "Enter a brief description of what was done here."))))

;;
;; interactive functions to set urgency and distribution
;;

(defun debian-changelog-distribution ()
  "Delete the current distribution and prompt for a new one."
  (interactive)
  (if (eq (debian-changelog-finalised-p) t)
      (error (substitute-command-keys "most recent version has been finalised - use \\[debian-changelog-unfinalise-last-version] or \\[debian-changelog-add-version]")))
  (let ((str (completing-read
              "Select distribution: "
	      debian-changelog-allowed-distributions
              nil t nil)))
    (if (not (equal str ""))
	(debian-changelog-setdistribution str))))

(defun debian-changelog-urgency ()
  "Delete the current urgency and prompt for a new one."
  (interactive)
  (if (eq (debian-changelog-finalised-p) t)
      (error (substitute-command-keys "most recent version has been finalised - use \\[debian-changelog-unfinalise-last-version] or \\[debian-changelog-add-version]")))
  (let ((str (completing-read
              "Select urgency: "
              '(("low" 1) ("medium" 2) ("high" 3) ("critical" 4))
              nil t nil)))
    (if (not (equal str ""))
	(debian-changelog-seturgency str))))

;;
;; internal function: test if changelog has been finalized or not
;; New version by Tommi Virtanen 
;; Sun, 24 Jun 2001 16:03:01 UTC;  Debian bug #102088
;; -
;; regexp tweaked by psg, Tue Jul 10 15:29:54 EDT 2001

(defun debian-changelog-finalised-p ()
  "Check whether the most recent debian-style changelog entry is finalised yet.
\(ie, has a maintainer name and email address and a release date."
  (save-excursion
    (goto-char (point-min))
    (or (re-search-forward "\n\\S-" (point-max) t)
	(goto-char (point-max)))
    (if (re-search-backward "\n --" (point-min) t)
	(forward-char 4)
      ;;(beginning-of-line)
      ;;(insert " --\n\n")
      ;;(backward-char 2)
      )
    (cond
     ((looking-at
       "[ \n]+\\S-[^\n\t]+\\S- <[^ \t\n<>]+> +\\S-[^\t\n]+\\S-[ \t]*\n")
      t)
     ((looking-at "[ \t]*\n")
      nil)
     (t
      "finalisation line has bad format (not ` -- maintainer  date')"))))
;;
;;  interactive functions to add new versions (whole new sections)
;;  to changelog.
;;

(defvar debian-changelog-new-upstream-release-p nil)

(defun debian-changelog-add-new-upstream-release ()
  "Normal hook for adding \"new upstream release\" entry to changelog."
    (when debian-changelog-new-upstream-release-p
      (insert "New upstream release")
      (setq debian-changelog-new-upstream-release-p nil)))

(defun debian-changelog-add-version ()
  "Add a new version section to a debian-style changelog file.
If file is empty, create initial entry."
  (interactive)
  (if (not (= (point-min)(point-max)))
      (let ((f (debian-changelog-finalised-p)))
        (and (stringp f) (error f))
        (or f (error "Previous version not yet finalised"))))
  (goto-char (point-min))
  (let ((pkg-name (or (debian-changelog-suggest-package-name)
                      (read-string "Package name: ")))
        (version (or (debian-changelog-suggest-version)
                     (read-string "New version (including any revision): "))))
    (if (debian-changelog-experimental-p)
        (insert pkg-name " (" version ") experimental; urgency=low\n\n  * ")
      (insert pkg-name " (" version ") " (car debian-changelog-allowed-distributions) "; urgency=low\n\n  * "))
    (run-hooks 'debian-changelog-add-version-hook)
    (save-excursion (insert "\n\n --\n\n"))))

(defun debian-changelog-experimental-p ()
;; Peter S Galbraith, 04 May 2001
  "Return t if last upload is to experimental."
  (save-excursion
    (goto-char (point-min))
    (looking-at "\\sw.* (.+).* \\(experimental\\)")))

(defun debian-changelog-suggest-package-name ()
;; Peter S Galbraith, 23 Feb 2001
  "Return package name from first line of the changelog, or nil."
  (save-excursion
    (goto-char (point-min))
    (if (looking-at
         "\\(\\S-+\\) +(\\([^()\n\t-]+\\)\\(-\\([^()]+\\)\\)?\\() +[^\n]*\\)")
        (match-string-no-properties 1))))

(defun debian-changelog-greater-than (vsn1 vsn2)
  "Return t if VSN1 is greater than VSN2."
  (save-excursion
    (let ((tmp-buffer (get-buffer-create
                       " *debian-changelog-mode-temp-buffer*")))
      (set-buffer tmp-buffer)
      (unwind-protect
          (progn
            (let ((mesg (call-process "dpkg" nil '(t nil) nil
                                      "--compare-versions" vsn1 "gt" vsn2)))
              (if (equal mesg 0)
                  t
                nil)))
        (kill-buffer tmp-buffer)))))

(defun debian-changelog-suggest-version ()
;; Peter S Galbraith, 23 Feb 2001
  "Return a suggested new version number to use for this changelog, or nil."
  (save-excursion
    (goto-char (point-min))
    (let ((findmatch t))
      (cond
       ((looking-at
;;; The following is not strictly correct.  The upstream version may actually
;;; contain a hyphen if a debian version number also exists, making two hyphens
;;; I'm also assuming it begins with a digit, which is not enforced
         "\\(\\S-+\\) +(\\([0-9]:\\)?\\([0-9][0-9a-zA-Z.+:~]*\\)\\(-\\([0-9a-zA-Z.+~]+\\)\\)?\\() +[^\n]*\\)"))

     ;; No match...
     ;; Check again for multiple hyphens, and adjust match-data if found
     ;; to leave only the bit past the last hyphen as the debian version
     ;; number.
       ((looking-at
         "\\(\\S-+\\) +(\\([0-9]:\\)?\\([0-9][0-9a-zA-Z.+:~]*\\)\\(-\\([0-9a-zA-Z.+~]+\\)\\)*\\() +[^\n]*\\)")
        ;; We have a hit.  Adjust match-data...
        (goto-char (match-end 5))
        (skip-chars-backward "0-9a-zA-Z.+~")
        (let ((deb-vsn-beg (point))
              (ups-vsn-end (1- (point))))
          (store-match-data
           (list
            (match-beginning 0)(match-end 0)
            (match-beginning 1)(match-end 1)
            (match-beginning 2)(match-end 2)
            (match-beginning 3) ups-vsn-end
            (match-beginning 4)(match-end 4)
            deb-vsn-beg        (match-end 5)
            (match-beginning 6)(match-end 6)))))
       (t
        (setq findmatch nil)))


;;; match 1: package name
;;; match 2: epoch, if it exists
;;; match 3: upstream version number
;;; match 4: debian version number exists if matched
;;; match 5: debian version number
;;; match 6: rest of string
      (if (not findmatch)
          nil
        (let ((pkg-name (match-string-no-properties 1))
              (epoch (or (match-string-no-properties 2) ""))
              (upstream-vsn (match-string-no-properties 3))
              (debian-vsn (match-string-no-properties 5)))
          ;;debug (message "name: %s  epoch: %s  version: %s  debian: %s" pkg-name epoch upstream-vsn debian-vsn))))

          (cond
           ;; Debian vsn exists + Old upstream version matches current one.
           ;; -> Increment Debian version...
           ((and debian-vsn
                 (string-match
                  (regexp-quote (concat "/" pkg-name "-" upstream-vsn "/debian/changelog"))
                  buffer-file-name))
            (concat epoch upstream-vsn "-"
                    (debian-changelog-increment-version debian-vsn)))

           ;; Same as above, but more general in case directory name doesn't
           ;; match package name.  -> Increment Debian version...
           ((and debian-vsn
                 (string-match
                  (concat "-" (regexp-quote upstream-vsn) "/debian/changelog")
                  buffer-file-name))
            (concat epoch upstream-vsn "-"
                    (debian-changelog-increment-version debian-vsn)))

           ;; Debian vsn exists but old upstream version doesn't match new one.
           ;; -> Use new upstream version with "-1" debian version.
;;;FIXME: I should perhaps check that the directory name version is higher
;;;than that currently in changelog.
           ((and debian-vsn
                 (string-match (concat
                                "/"
                                (regexp-quote pkg-name)
                                "-\\([0-9][0-9a-zA-Z.+~-]+\\)/debian/changelog")
                               buffer-file-name))
            (setq debian-changelog-new-upstream-release-p t)
            (concat epoch (match-string 1 buffer-file-name) "-1"))

           ;; Same as above, but more general in case directory name doesn't
           ;; match package name.
           ;; -> Use new upstream version with "-1" debian version.
           ((and debian-vsn
                 (string-match
                  (concat "-\\([0-9][0-9a-zA-Z.+~-]+\\)/debian/changelog")
                  buffer-file-name))
            (setq debian-changelog-new-upstream-release-p t)
            (concat epoch (match-string 1 buffer-file-name) "-1"))

           ;; Debian vsn exists, but directory name has no version
           ;; -> increment Debian vsn (no better guess)
           (debian-vsn
            (concat epoch upstream-vsn "-"
                    (debian-changelog-increment-version debian-vsn)))

         ;;; No Debian version number...

           ;; No debian version number and version number from changelog
           ;; already greater than from directory name.
           ((and (not debian-vsn)
                 (not (string-match
                       (concat "/" (regexp-quote pkg-name) "-"
                               (regexp-quote upstream-vsn) "/debian/changelog")
                       buffer-file-name))
                 (string-match (concat "/" (regexp-quote pkg-name)
                                       "-\\([0-9a-zA-Z.+~]+\\)/debian/changelog")
                               buffer-file-name)
                 (debian-changelog-greater-than
                  upstream-vsn (match-string 1 buffer-file-name)))
            (concat epoch (debian-changelog-increment-version upstream-vsn)))

           ;; No debian version number (Debian native) and old upstream
           ;; version matches new one (e.g. 'dpk-source -x package' without
           ;; then bumping up the version in the directory name.
           ((and (not debian-vsn)
                 (string-match (concat "/" (regexp-quote pkg-name) "-"
                                       (regexp-quote upstream-vsn)
                                       "/debian/changelog")
                               buffer-file-name)
                 (concat epoch
                         (debian-changelog-increment-version upstream-vsn))))

           ;; No debian version number and version number from changelog
           ;; less than from directory name.
           ((and (not debian-vsn)
                 (not (string-match
                       (concat "/" (regexp-quote pkg-name) "-"
                               (regexp-quote upstream-vsn) "/debian/changelog")
                       buffer-file-name))
                 (string-match (concat
                                "/" (regexp-quote pkg-name)
                                "-\\([0-9a-zA-Z.+~]+\\)/debian/changelog")
                               buffer-file-name)
                 (debian-changelog-greater-than
                  (match-string 1 buffer-file-name) upstream-vsn))
            (concat epoch (match-string 1 buffer-file-name)))

           ((string-match (concat "/" (regexp-quote pkg-name)
                                  "-\\([0-9a-zA-Z.+~]+\\)/debian/changelog")
                          buffer-file-name)
            ;;Hmmm.. return version number from directory if we get this far
            (concat epoch (match-string 1 buffer-file-name)))
           ((string-match
             (concat "-\\([0-9][0-9a-zA-Z.+~]+\\)/debian/changelog")
             buffer-file-name)
            ;;Hmmm.. return version number from directory if we get this far
            (concat epoch (match-string 1 buffer-file-name)))

           ;; Directory name has no version -> increment what we have.
           (t
            (concat epoch
                    (debian-changelog-increment-version upstream-vsn)))))))))

(defun debian-changelog-increment-version (version)
;; Peter S Galbraith, 09 Mar 2001
  "Increment the last numeric portion of a VERSION number.
1        -> 2
0potato1 -> 0potato2
1.01     -> 1.02"
  (cond
   ((string-match "[1-9][0-9]*$" version)
    (let ((first-part (substring version 0 (match-beginning 0)))
	  (snd-part (match-string 0 version)))
      (concat
       first-part (number-to-string (+ 1 (string-to-number snd-part))))))
   ((string-match "[0-9]*$" version)
    ;; 3.5.4.0 -> 3.5.4.1
    (let ((first-part (substring version 0 (match-beginning 0)))
	  (snd-part (match-string 0 version)))
      (concat
       first-part (number-to-string (+ 1 (string-to-number snd-part))))))
   (t
    ;; Safety net only - first condition should catch all
    (number-to-string (+ 1 (string-to-number version))))))

(defun debian-changelog-finalise-and-save ()
  "Finalise, if necessary, and then save a debian-style changelog file."
  (interactive)
  (let ((f (debian-changelog-finalised-p)))
    (and (stringp f) (error f))
    (or f (debian-changelog-finalise-last-version)))
  (save-buffer))

;;
;; internal function to get date as string (used by finalising routines)
;;

(defun debian-changelog-date-string ()
  "Return RFC-822 format date string.
Use UTC if `debian-changelog-date-utc-flag' is non-nil."
  (let* ((dp "date")
	 (cp (point))
	 (ret
	  (let ((process-environment process-environment)
		(tz (dolist (item process-environment)
		      (when (and (stringp item)
				 (string-match "^TZ=" item))
			(return item)))))
	    (when debian-changelog-date-utc-flag
	      (setq process-environment
		    (delete tz process-environment))
	      (push "TZ=UTC" process-environment))
	    (call-process "date" nil t nil "-R")))
	 (np (point))
	 (out nil))
    (cond ((not (or (eq ret nil) (eq ret 0)))
	   (setq out (buffer-substring-no-properties cp np))
	   (delete-region cp np)
	   (error (concat "error from " dp ": " out)))
	  (t
	   (backward-char)
	   (or (looking-at "\n")
	       (error (concat "error from " dp ": expected newline after date string")))
	   (setq out (buffer-substring-no-properties cp (- np 1)))
	   (delete-region cp np)
	   out))))

;;
;; interactive functions to finalize entry
;;

;;; Use debian-changelog-full-name and debian-changelog-mailing-address instead
;; (make-local-variable 'add-log-full-name)
;; (make-local-variable 'add-log-mailing-address)

(defun debian-changelog-finalise-last-version ()
  "Finalise maintainer's name and email and release date."
  (interactive)
  (and (debian-changelog-finalised-p)
       (debian-changelog-unfinalise-last-version))
  (if debian-changelog-local-variables-maybe-remove
      (debian-changelog-local-variables-maybe-remove))
  (save-excursion
    (goto-char (point-min))
    (re-search-forward "\n --\\([ \t]*\\)")
    (delete-region (match-beginning 1) (match-end 1))
    (insert " " debian-changelog-full-name
            " <" debian-changelog-mailing-address ">  "
	    (debian-changelog-date-string))))

(defun debian-changelog-last-maintainer ()
  "Return maintainer name and e-mail of the last changelog entry as
a list in the form (NAME EMAIL)."
  (save-excursion
    (goto-char (point-min))
    (let ((string
	   (if (re-search-forward "^ -- \\(.*\\)>" nil t)
	       (if (fboundp 'match-string-no-properties)
		   (match-string-no-properties 1)
		 (match-string 1))
	     (error "Maintainer name and email not found."))))
      (split-string string " <"))))

(defun debian-changelog-web-developer-page ()
  "Browse the BTS for the last upload maintainer's developer summary page."
  (interactive)
  (if (not (featurep 'browse-url))
      (progn
        (load "browse-url" nil t)
        (if (not (featurep 'browse-url))
            (error "This function requires the browse-url elisp package"))))
  (let ((email (cadr (debian-changelog-last-maintainer))))
    (browse-url (concat "http://qa.debian.org/developer.php?login=" email))
    (message "Looking up developer summary page for %s via browse-url" email)))

;; co-maintenance as per bug #352957 by Luca Capello 2006
(defun debian-changelog-comaintainer-insert (name separator)
  "In the line before SEPARATOR, insert the co-maintainer name as for
the form [ NAME ]."
  (goto-char (point-min))
  (re-search-forward (concat "\n " separator))
  (previous-line 1)
  (insert "\n  [ " name " ]")
  (when (string= "--" separator)
    (insert "\n")))
  
(defun debian-changelog-comaintainer ()
  "If the last maintainer is different from the current one, create a
co-maintained changelog entry."
  (let ((name (car (debian-changelog-last-maintainer))))
    (unless (string= name debian-changelog-full-name)
      (let ((maintainers-found)
	    (debian-changelog-last-entry-end
	     (progn (goto-char (point-min))
		    (re-search-forward "\n --"))))
	(mapc (lambda (x)
		(goto-char (point-min))
		(when (search-forward x debian-changelog-last-entry-end t)
		  (add-to-list 'maintainers-found x)))
	      (list name debian-changelog-full-name))
	;; set the co-maintenance if any
	(if maintainers-found
	    ;; co-maintenance, debian-changelog-full-name is not present
	    (if (and (member name maintainers-found)
		     (not (member debian-changelog-full-name
				  maintainers-found)))
		(debian-changelog-comaintainer-insert
		 debian-changelog-full-name "--"))
	  ;; no co-maintenance
	  (mapc (lambda (x)
		  (debian-changelog-comaintainer-insert (car x) (cadr x)))
		`((,name " *") (,debian-changelog-full-name "--"))))))))

;;
;; interactive function to unfinalise changelog (so modifications can be made)
;;

(defun debian-changelog-unfinalise-last-version ()
  "Remove the `finalisation' information.
Removes maintainer's name, email address and release date so that new entries
can be made."
  (interactive)
  (if (debian-changelog-finalised-p) nil
    (error "Most recent version is not finalised"))
  (save-excursion
    (debian-changelog-comaintainer)
    (goto-char (point-min))
    (re-search-forward "\n --")
    (let ((dels (point)))
      (end-of-line)
      (delete-region dels (point)))))

;;
;; top level interactive function to activate mode
;;

(defvar imenu-create-index-function)
;;;###autoload
(defun debian-changelog-mode ()
  "Major mode for editing Debian-style change logs.
Runs `debian-changelog-mode-hook' if it exists.

Key bindings:

\\{debian-changelog-mode-map}

If you want to use your debian.org email address for debian/changelog
entries without using it for the rest of your email, use the `customize`
interface to set it, or simply set the variable
`debian-changelog-mailing-address' in your ~/.emacs file, e.g.

 (setq debian-changelog-mailing-address \"myname@debian.org\"))"

  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'debian-changelog-mode
	mode-name "Debian changelog"
        left-margin 2
	fill-prefix "  "
	fill-column 74)
  ;;(hack-local-variables)
  ;;  Can't hack-local-varibles because a "mode: " creates an infinite loop.
  ;;  It doesn't matter anyway.  The Local Variable block is parsed after
  ;;  the mode is run when visited by find-file.  That's the only time it's
  ;;  done.
  (use-local-map debian-changelog-mode-map)
  ;; Let each entry behave as one paragraph:
; (set (make-local-variable 'paragraph-start) "\\*")
; (set (make-local-variable 'paragraph-separate) "\\*\\|\\s-*$|\\S-")
  ;; PSG: The following appears to get fill-paragraph to finally work!
  (set (make-local-variable 'paragraph-start) "\\*\\|\\s *$\\|\f\\|^\\<")
  (set (make-local-variable 'paragraph-separate) "\\s *$\\|\f\\|^\\<")
  ;; Let each version behave as one page.
  ;; Match null string on the heading line so that the heading line
  ;; is grouped with what follows.
  (set (make-local-variable 'page-delimiter) "^\\<")
  (set (make-local-variable 'version-control) 'never)
  (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
  (set (make-local-variable 'font-lock-defaults)
       '((debian-changelog-font-lock-keywords
          debian-changelog-font-lock-keywords-1
          debian-changelog-font-lock-keywords-2) t t))
  (set (make-local-variable
	'debian-changelog-local-variables-maybe-remove-done) nil)
  (set (make-local-variable 'indent-line-function) 'indent-relative-maybe)
  (set (make-local-variable 'outline-regexp) "^[a-z]")
  (setq local-abbrev-table text-mode-abbrev-table)
  (set-syntax-table text-mode-syntax-table)
  (debian-bug-bug-menu-init debian-changelog-mode-map)
  (easy-menu-add debian-changelog-menu)
  (cond
   (debian-changelog-use-imenu
    (require 'imenu)
    (setq imenu-create-index-function 'imenu--create-debian-changelog-index)
    (if (or window-system
            (fboundp 'tmm-menubar))
        (progn
          (imenu-add-to-menubar "History")
          ;(imenu-update-menubar)
          ))))
  (cond
   (debian-changelog-highlight-mouse-t
    (debian-changelog-setup-highlight-mouse-keymap)
    (debian-changelog-highlight-mouse)))
  (run-hooks 'debian-changelog-mode-hook))
;;(easy-menu-add debian-changelog-menu))

;;
;; font-lock face defs by Peter Galbraith

(defvar debian-changelog-warning-face 'debian-changelog-warning-face
  "Face to use for important keywords.")

(cond
 ((and (fboundp 'facep)
       (facep 'font-lock-warning-face))
  (copy-face 'font-lock-warning-face 'debian-changelog-warning-face))
 ((fboundp 'defface)
  (defface debian-changelog-warning-face
    '((((class grayscale)(background light))(:foreground "DimGray" :bold t))
      (((class grayscale)(background dark))(:foreground "LightGray" :bold t))
      (((class color)(background light))(:foreground "red" :bold t ))
      (((class color)(background dark))(:foreground "red" :bold t ))
      (t (:bold t)))
    "Face for debian-changelog important strings."
    :group 'debian-changelog-faces))
 (t
  ;;; XEmacs19:
  (make-face 'debian-changelog-warning-face
             "Face to use for important keywords.in debian-changelog-mode")
  (make-face-bold 'debian-changelog-warning-face)
  ;; XEmacs uses a tag-list thingy to determine if we are using color
  ;;  or mono (and I assume a dark background).
  (set-face-foreground 'debian-changelog-warning-face
                       "red" 'global nil 'append)))

;;
;; font-lock definition by Chris Waters,
;;           revisited by Peter Galbraith (Apr 2001)

;; Available faces:
;; keyword-face, type-face, string-face, comment-face,
;; variable-name-face, function-name-face
;; in emacs only:  builtin-face, constant-face, warning-face
;; in xemacs only: reference-face, doc-string-face, preprocessor-face

;; the mappings I've done below only use faces available in both emacsen.
;; this is somewhat limiting; I may consider adding my own faces later.

(defvar debian-changelog-font-lock-keywords-1
  (list
    ;; package name line: pkg (1.0-1) unstable; urgency=low
   '(debian-changelog-fontify-version
     (1 font-lock-function-name-face)
     (2 font-lock-type-face nil t)
     (3 font-lock-string-face nil t)
     (4 debian-changelog-warning-face nil t))
   '(debian-changelog-fontify-stable . debian-changelog-warning-face)
   '(debian-changelog-fontify-frozen . font-lock-type-face)
   '(debian-changelog-fontify-unstable . font-lock-string-face)
   '(debian-changelog-fontify-experimental . debian-changelog-warning-face)
   '(debian-changelog-fontify-unreleased . debian-changelog-warning-face)
   '(debian-changelog-fontify-urgency-crit . debian-changelog-warning-face)
   '(debian-changelog-fontify-urgency-high . debian-changelog-warning-face)
   '(debian-changelog-fontify-urgency-med . font-lock-type-face)
   '(debian-changelog-fontify-urgency-low . font-lock-string-face)
   ;; bug closers
   '(;"\\(closes:\\) *\\(\\(bug\\)?#? *[0-9]+\\(, *\\(bug\\)?#? *[0-9]+\\)*\\)"
     ;; Process lines that continue on multiple lines - Fred Bothamy
     "\\(closes:\\)[ \t\n]*\\(\\(bug\\)?#? *[0-9]+\\(,[ \t\n]*\\(bug\\)?#? *[0-9]+\\)*\\)"
     (1 font-lock-keyword-face)
     (2 debian-changelog-warning-face))
   '("^\t.*$" . debian-changelog-warning-face)
   ;; maintainer line (enforce 2 space exactly between email and date)
   '("^ -- \\(.+\\) <\\(.+@.+\\)>  \\([^ ].+\\)$"
     (1 font-lock-variable-name-face)
     (2 font-lock-variable-name-face)
     (3 font-lock-string-face)))
  "First level highlighting for `debian-changelog-mode'.")

(defvar debian-changelog-font-lock-keywords-2
  (append
   debian-changelog-font-lock-keywords-1
   ;; bullet lines
   '(("^  +\\(\\*\\)" 1 font-lock-comment-face)))
  "High level highlighting for `debian-changelog-mode'.")

(defvar debian-changelog-font-lock-keywords
  debian-changelog-font-lock-keywords-1
  "Default expressions to highlight in `debian-changelog-mode'.")

;; Fontifier function by Peter Galbraith, Apr 24 2001

(defun debian-changelog-fontify-version (limit)
  "Return match for package name and version number up to LIMIT.
match 1 -> package name
      2 -> native vsn number
      3 -> non-native vsn number
      4 -> non-native NMU vsn number"
  (when (re-search-forward
;;; The following is not strictly correct.  The upstream version may actually
;;; contain a hyphen if a debian version number also exists, making two hyphens
;;; I'm assuming it begins with a digit, which is not enforced
         "^\\(\\S-+\\) (\\([0-9]:\\)?\\([0-9][0-9a-zA-Z.+:~]*\\)\\(-\\([0-9a-zA-Z.+~]+\\)\\)*)" nil t)
;;                                                                                           ^
;; Note the asterix above, allowing more than one hyphen in the version
;; number, but wrongly assuming that all of it is the Debian version
;; instead of only the bit past the last hyphen.  I might get NMUs wrongly
;; for version numbers with multiple hyphens.

;; match 1: package name
;; match 2: epoch, if it exists
;; match 3: upstream version number
;; match 4: debian version number exists if matched
;; match 5: debian version number
    (cond
     ((not (match-string 4))
      ;; No Debian version number -> Debian native package
      (store-match-data
       (list (match-beginning 1)(match-end 3)
             (match-beginning 1)(match-end 1)
             (match-beginning 3)(match-end 3)
             nil nil
             nil nil)))
     ((match-string 4)
      ;; Debian version number -> Let's see if NMU...
      (let* ((deb-vsn (match-string 5))
             (is-NMU (save-match-data (string-match "\\." deb-vsn))))
        (cond
         (is-NMU
          (store-match-data
           (list (match-beginning 1)(match-end 5)
                 (match-beginning 1)(match-end 1)
                 nil nil
                 nil nil
                 (match-beginning 3)(match-end 5))))
         (t
          (store-match-data
           (list (match-beginning 1)(match-end 5)
                 (match-beginning 1)(match-end 1)
                 nil nil
                 (match-beginning 3)(match-end 5)
                 nil nil)))))))
    t))

(defun debian-changelog-fontify-urgency-crit (limit)
  (when (re-search-forward "^\\sw.* (.+).*; \\(urgency=critical\\)" limit t)
    (store-match-data
     (list (match-beginning 1)(match-end 1)))
    t))

(defun debian-changelog-fontify-urgency-high (limit)
  (when (re-search-forward "^\\sw.* (.+).*; \\(urgency=high\\)" limit t)
    (store-match-data
     (list (match-beginning 1)(match-end 1)))
    t))

(defun debian-changelog-fontify-urgency-med (limit)
  (when (re-search-forward "^\\sw.* (.+).*; \\(urgency=medium\\)" limit t)
    (store-match-data
     (list (match-beginning 1)(match-end 1)))
    t))

(defun debian-changelog-fontify-urgency-low (limit)
  (when (re-search-forward "^\\sw.* (.+).*; \\(urgency=low\\)" limit t)
    (store-match-data
     (list (match-beginning 1)(match-end 1)))
    t))

(defun debian-changelog-fontify-stable (limit)
  (when (re-search-forward "^\\sw.* (.+).* \\(\\(old\\)?stable\\(-security\\)?\\)" limit t)
    (store-match-data
     (list (match-beginning 1)(match-end 1)))
    t))

(defun debian-changelog-fontify-frozen (limit)
  (when (re-search-forward "^\\sw.* (.+).* \\(testing\\(-security\\)?\\|frozen\\|woody-proposed-updates\\)" limit t)
    (store-match-data
     (list (match-beginning 1)(match-end 1)))
    t))

(defun debian-changelog-fontify-unstable (limit)
  (when (re-search-forward "^\\sw.* (.+).* \\(unstable\\)" limit t)
    (store-match-data
     (list (match-beginning 1)(match-end 1)))
    t))

(defun debian-changelog-fontify-experimental (limit)
  (when (re-search-forward "^\\sw.* (.+).* \\(experimental\\)" limit t)
    (store-match-data
     (list (match-beginning 1)(match-end 1)))
    t))

(defun debian-changelog-fontify-unreleased (limit)
  (when (re-search-forward "^\\sw.* (.+).* \\(UNRELEASED\\)" limit t)
    (store-match-data
     (list (match-beginning 1)(match-end 1)))
    t))

;;
;; browse-url interfaces, by Peter Galbraith, Feb 23 2001
;;

(defvar debian-changelog-is-XEmacs
  (not (null (save-match-data (string-match "XEmacs\\|Lucid" emacs-version)))))

(defvar debian-changelog-mouse-keymap nil
  "Keymap for mouse commands.")

(defun debian-changelog-setup-highlight-mouse-keymap ()
  (setq debian-changelog-mouse-keymap
   ;;; First, copy the local keymap so we don't have `disappearing' menus
   ;;; when the mouse is moved over a bug number.

   ;;; FIXME: Check out (mouse-major-mode-menu) to see how it grabs the local
   ;;;        menus to display.
        (let ((m (copy-keymap (current-local-map))))
;;          (cond
;;           ((and debian-changelog-use-imenu
;;                 (or window-system (fboundp 'tmm-menubar)))
;;            (imenu-add-to-menubar "History")))
          (cond
           (debian-changelog-is-XEmacs
            (set-keymap-name m 'debian-changelog-mouse-keymap)
            (define-key m [button3]
              'debian-bug-web-this-bug-under-mouse))
           (t
            (define-key m [down-mouse-3]
              'debian-bug-web-this-bug-under-mouse)))
          m)))

(defvar debian-changelog-ext-list nil
  "XEmacs buffer-local list of debian-changelog-cite extents.")
(make-variable-buffer-local 'debian-changelog-ext-list)
(put 'debian-changelog-ext-list 'permanent-local t)

(defun debian-changelog-highlight-mouse ()
  "Make that nice green highlight when the mouse is over a bug number.
Also set keymap."
  (interactive)
  (save-excursion
    (let ((s)(e)(extent)(local-extent-list debian-changelog-ext-list)
          (inhibit-read-only t)
          (modified (buffer-modified-p))) ;put-text-property changing this?
      ;; Remove the mouse face properties first.
      (setq debian-changelog-ext-list nil)		;Reconstructed below...
      (if (string-match "XEmacs\\|Lucid" emacs-version)
          (while local-extent-list
	    (setq extent (car local-extent-list))
 	    (if (or (extent-detached-p extent)
 		    (and (<= (point-min)(extent-start-position extent))
 			 (>= (point-max)(extent-end-position extent))))
		(delete-extent extent)
	      (setq debian-changelog-ext-list
                    (cons extent debian-changelog-ext-list)))
            (setq local-extent-list (cdr local-extent-list)))
        ;; Remove properties for regular emacs
        ;; FIXME This detroys all mouse-faces and local-maps!
        (let ((before-change-functions) (after-change-functions))
          (remove-text-properties (point-min) (point-max)
                                  '(mouse-face t local-map t))))
      (goto-char (point-min))
      ;; FIXME: Ideally, I want to hightlight _only_ the digit parts
      ;; (skipping the coma, and the word "bug".
      (while
          (re-search-forward
;;;        "\\(closes:\\) *\\(\\(bug\\)?#? *[0-9]+\\(, *\\(bug\\)?#? *[0-9]+\\)*\\)"
           ;; Same deal as for font-lock - patch from Fred Bothamy.
           "\\(closes:\\)[ \t\n]*\\(\\(bug\\)?#? *[0-9]+\\(,[ \t\n]*\\(bug\\)?#? *[0-9]+\\)*\\)"
           nil t)
        (setq s (match-beginning 2))
        (setq e (match-end 2))
        (cond
         ((string-match "XEmacs\\|Lucid" emacs-version)
          (setq extent (make-extent s e))
          (setq debian-changelog-ext-list
                (cons extent debian-changelog-ext-list))
          (set-extent-property extent 'highlight t)
          (set-extent-property extent 'start-open t)
;	  (set-extent-property extent 'balloon-help 'debian-changelog-label-help)
;	  (set-extent-property extent 'help-echo 'debian-changelog-label-help-echo)
          (set-extent-property extent 'keymap debian-changelog-mouse-keymap))
         (t
          (let ((before-change-functions) (after-change-functions))
            (put-text-property s e 'local-map
                               debian-changelog-mouse-keymap)
            (put-text-property s e 'mouse-face 'highlight)))))
      (set-buffer-modified-p modified))))

;;;-------------
;;; imenu stuff - Peter Galbraith, May 2001

(eval-when-compile
  (require 'cl)
  (if (fboundp 'imenu)                    ;Make sure auto-load is loaded
      (require 'imenu)))

(defvar debian-changelog-imenu-doing-closebug nil
  "Internal flag set when imenu is processing many bug closings.")
(make-variable-buffer-local 'debian-changelog-imenu-doing-closebug)

(defun debian-changelog-imenu-prev-index-position-function ()
  (cond
   (debian-changelog-imenu-doing-closebug
    (if (not (posix-search-backward
              "\\(closes:\\)\\|[^0-9]\\([0-9]+\\)" nil t))
        nil                             ; No match
      ;; match 1 -> "closes:"
      ;; match 2 -> a bug number
      (cond
       ((match-string 1)
        (setq debian-changelog-imenu-doing-closebug nil)
        (debian-changelog-imenu-prev-index-position-function))
       (t
        ;; Return the bug number match
        t))))
   (t
    (if (not (re-search-backward
              "\\(closes: *\\(bug\\)?#? *[0-9]+\\)\\|\\(^\\sw.* (\\(.+\\))\\)"
              nil t))
        nil                             ; No match
      ;; match 1 -> "closes:"
      ;; match 4 -> a version number
      (cond
       ((match-string 1)
        (setq debian-changelog-imenu-doing-closebug t)
        (forward-char -1)
        (re-search-forward
         "\\(closes:\\) *\\(\\(bug\\)?#? *[0-9]+\\(, *\\(bug\\)?#? *[0-9]+\\)*\\)"
         nil t)
        (forward-char 1)
        (debian-changelog-imenu-prev-index-position-function))
       (t
        ;; Return the version number match
        t))))))

(defvar debian-changelog-imenu-counter nil
  "Debian-changelog-mode internal variable for imenu support.")

(defun imenu--create-debian-changelog-index ()
    (save-match-data
      (save-excursion
        (let ((index-alist '())
              (index-bug-alist '())
              (index-bugsorted-alist '())
              (prev-pos 0)
              (imenu-scanning-message "Scanning changelog for History (%3d%%)")
              )
          (setq debian-changelog-imenu-counter -99)
          (goto-char (point-max))
          (imenu-progress-message prev-pos 0 t)
;;;          (message "Scanning changelog history...")
          (setq debian-changelog-imenu-doing-closebug nil)
          (while (debian-changelog-imenu-prev-index-position-function)
            (imenu-progress-message prev-pos nil t)
            (let ((marker (make-marker)))
              (set-marker marker (point))
              (cond
               ((match-beginning 2)     ;bug number
                (push (cons (match-string-no-properties 2) marker)
                      index-bug-alist))
               ((match-beginning 4)     ;version number
                (push (cons (match-string-no-properties 4) marker)
                      index-alist)))))
          (imenu-progress-message prev-pos 100 t)
;;;       (message "Scanning changelog history... done.")
          (cond
           (index-bug-alist
            (push (cons "Closed Bugs (chrono)"
                        index-bug-alist)
                  index-alist)
            (setq index-bugsorted-alist (copy-alist index-bug-alist))
            (push (cons "Closed Bugs (sorted)"
                        (sort index-bugsorted-alist
                              'debian-changelog-imenu-sort))
                  index-alist)))
          index-alist))))

(defun debian-changelog-imenu-sort (el1 el2)
  "Predicate to compare labels in lists."
  (string< (car el2) (car el1) ))

;;; end of imenu stuff
;;;-------------

;;; Setup auto-mode-alist
;; (in case /etc/emacs/site-start.d/50dpkg-dev.el not used)
;;
;; Crib note: no need for "NEWS.Debian.gz" or "changelog.Debian.gz" entries
;; since jka-compr.el dispatches using the basename after uncompressing.

(add-to-list 'auto-mode-alist '("/debian/*NEWS" . debian-changelog-mode))
(add-to-list 'auto-mode-alist '("NEWS.Debian" . debian-changelog-mode))

;;(add-to-list 'auto-mode-alist '("/debian/changelog\\'" . debian-changelog-mode))
;;; Instead use this.  See http://bugs.debian.org/457047 by Trent W. Buck
;;; Valid package names spec is Debian Policy section 5.6.7
(add-to-list
 'auto-mode-alist
 '("/debian/\\([[:lower:][:digit:]][[:lower:][:digit:].+-]+\\.\\)?changelog\\'"
   . debian-changelog-mode))

(add-to-list 'auto-mode-alist '("changelog.Debian" . debian-changelog-mode))
  ;; For debchange
(add-to-list 'auto-mode-alist '("changelog.dch" . debian-changelog-mode))

;;;###autoload(add-to-list 'auto-mode-alist '("/debian/*NEWS" . debian-changelog-mode))
;;;###autoload(add-to-list 'auto-mode-alist '("NEWS.Debian" . debian-changelog-mode))
;;;###autoload(add-to-list 'auto-mode-alist '("/debian/\\([[:lower:][:digit:]][[:lower:][:digit:].+-]+\\.\\)?changelog\\'" . debian-changelog-mode))
;;;###autoload(add-to-list 'auto-mode-alist '("changelog.Debian" . debian-changelog-mode))
;;;###autoload(add-to-list 'auto-mode-alist '("changelog.dch" . debian-changelog-mode))

(provide 'debian-changelog-mode)

;;; debian-changelog-mode.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/dpkg-dev-el/debian-bts-control.el0000775000000000000000000013303112230377265022241 0ustar  ;;; debian-bts-control.el --- Create messages for Debian BTS control interface

;; Copyright (C) 2003, 2005, 2007, 2009 Peter S Galbraith
;;
;; Help text from http://www.debian.org/Bugs/server-control:
;; Debian BTS administrators 
;; Copyright 1999 Darren O. Benham, 1994-1997 Ian Jackson,
;;  1997 nCipher Corporation Ltd.
;;
;; This file 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 2, or (at your option)
;; any later version.
;;
;; debian-bts-mode.el 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 your Debian installation, in /usr/share/common-licenses/GPL
;; If not, write to the Free Software Foundation, 675 Mass Ave,
;; Cambridge, MA 02139, USA.

;;; Commentary:
;;
;;  Use `M-x debian-bts-control' to create an initial message, and
;;  `M-x debian-bts-control' again (or `C-c C-b') to insert new directives.

;;; Change log:
;;
;; V1.00 30apr2003  Peter S Galbraith 
;;  - Initial release.
;; V1.01 23May2003  Peter S Galbraith 
;;  - Add `debian-bts-control-modes-to-reuse'.
;; V1.02 09Aug2003  Peter S Galbraith 
;;  - add `debian-bts-control-prompt' to Prompt for bug number using sensible
;;    default if found.
;; V1.03 03Sep2003  Peter S Galbraith 
;;  - Don't set `debian-bts-control-verbose-prompts-flag' to t for Emacs20
;;    since it can't display multi-line prompts. (Closes: #208553)
;; V1.04 05Sep2003  Peter S Galbraith 
;;  - debian-bts-help-control: was missing!
;; V1.05 18Sep2003  Peter S Galbraith 
;;  - Add `package', `owner' and `noowner'.
;; V1.06 05Oct2003 Peter S Galbraith 
;;  - Add tags "sarge-ignore" and "fixed-uptsream".
;; V1.07 03Nov2003 Peter S Galbraith 
;;  - Created defgroup debian-bts-control.
;; V1.08 20Nov2005 Peter S Galbraith 
;;  - patch from Jari Aalto :
;;     It is now possible to put point at "Bug#NNNN" e.g. in debian/changelog
;;     and use that as default number.
;;      (top level): Added '(require 'cl)
;;      (debian-bts-bug-number-at-point): New function.
;;      (debian-bts-control-prompt): Code structure slightly redesigned.
;;      (debian-bts-control): Use `debian-bts-bug-number-at-point' to
;;      set `number-default'.
;; V1.08 08Aug2007 Peter S Galbraith 
;;  - Use `C-c C-b' instead of `C-c c' (Closes: #435247).
;; V1.09 30Aug2007 Peter S Galbraith 
;;  - skip over mml directives (Closes: #392132)
;; V1.10 30Aug2007 Peter S Galbraith 
;;  - Add `fixed' `notfixed' `block' `unblock' `archive' `unarchive'
;;    `found' `notfound'.  (Closes: #391647)
;; V1.11 23Feb2009, Patch from Luca Capello .
;;  - Add `debian-bts-control-cc-or-bcc' (Closes: #392494)
;; V1.12 11Nov2009 Peter S Galbraith 
;;  - Add `debian-bts-emailaddress' and `debian-bts-emaildomain'.
;;  - Add command `emacs-bts-control', new command to interface with Emacs BTS.
;; V1.13 21Nov2009 Peter S Galbraith 
;;  - Patches from Sven Joachim (Closes: #557408, #557412)
;; V1.14 19Dec2009 Peter S Galbraith 
;;  - Emacs BTS moved to debbugs.gnu.org 
;; V1.15 22Feb2010 Peter S Galbraith 
;;  - add autoload cookie for `emacs-bts-control' (Closes: #565934)
;;; Code:

(eval-when-compile '(require 'cl))
(require 'debian-bug)
(autoload 'word-at-point "thingatpt")

(defgroup debian-bts-control nil
  "Create messages for Debian BTS control interface"
  :group 'debian-bug)

(defcustom debian-bts-control-verbose-prompts-flag t
  "Non-nil means to be very verbose for `debian-bts-control' prompts."
  :group 'debian-bts-control
  :type 'boolean
  :set (lambda (symbol value)
         (if (<= 21 emacs-major-version)
             (set-default symbol value)
           (message
            "debian-bts-control-verbose-prompts-flag overridden for Emacs20")
           (set-default symbol nil))))

(defcustom debian-bts-control-modes-to-reuse
  '(mh-letter-mode mail-mode message-mode)
  "List of modes in which calling `debian-bts-control' will reuse the buffer.
No new draft will be created.  Instead control@bugs.debian.org will be
added to the `debian-bts-control-cc-or-bcc' field and the commands added at
the top of the message."
  :group 'debian-bts-control
  :type '(repeat symbol))

(defcustom debian-bts-control-cc-or-bcc 'cc
  "Whether to use Cc: or Bcc: header."
  :group 'debian-bts-control
  :type '(choice (const cc) (const bcc)))

(defvar debian-bts-emailaddress "control@bugs.debian.org"
  "Email address to send control message to.")

(defvar debian-bts-emaildomain "bugs.debian.org"
  "Email address domain to send control message to.")

(defvar debian-bts-control-minor-mode nil)
(defvar debian-bts-control-minor-mode-map nil
  "Keymap for `debian-bts-control' minor mode.")
(if debian-bts-control-minor-mode-map
    nil
  (setq debian-bts-control-minor-mode-map (make-sparse-keymap))
  (define-key debian-bts-control-minor-mode-map "\C-c\C-b" 'debian-bts-control))

(easy-menu-define debian-bts-control-menu debian-bts-control-minor-mode-map
  "Debian Bug Mode Menu"
  '("Control"
    ("Header"
     ["Custom From Address" (debian-bug--toggle-custom-From)
      :style toggle :active debian-bug-From-address
      :selected (debian-bug--is-custom-From)]
     "--"
     ["CC debian-devel" (debian-bug--toggle-CC-devel)
      :style toggle
      :selected (debian-bug--is-CC "debian-devel@lists.debian.org" "cc:")]
     ["CC me" (debian-bug--toggle-CC-myself)
      :style toggle :active debian-bug-From-address
      :selected (debian-bug--is-CC debian-bug-From-address "cc:")]
     )
     "--"
    ["Package" (debian-bts-control "package") t]
    ["Reassign" (debian-bts-control "reassign") t]
    ["Reopen" (debian-bts-control "reopen") t]
    ["Owner" (debian-bts-control "owner") t]
    ["NoOwner" (debian-bts-control "noowner") t]
    ["Submitter" (debian-bts-control "submitter") t]
    ["Forwarded" (debian-bts-control "forwarded") t]
    ["NotForwarded" (debian-bts-control "notforwarded") t]
    ["Retitle" (debian-bts-control "retitle") t]
    ["Severity" (debian-bts-control "severity") t]
    ["Clone" (debian-bts-control "clone") t]
    ["Merge" (debian-bts-control "merge") t]
    ["UnMerge" (debian-bts-control "unmerge") t]
    ["Tags" (debian-bts-control "tags") t]
    ["Close" (debian-bts-control "close") t]
     "--"
    ("Web View"
     ["Bugs for a Package..." (debian-bug-web-bugs) t]
     ["Bug Number..." (debian-bug-web-bug) t]
     ["Package Info..." (debian-bug-web-packages) t]
     )
    ["Customize"
     (customize-group "debian-bug") (fboundp 'customize-group)]
    ("Help"
     ["Severities" (debian-bug-help-severity) t]
     ["Tags" (debian-bug-help-tags) t]
     ["Pseudo-Packages" (debian-bug-help-pseudo-packages) t]
;;   ["Addresses" (debian-bug-help-email) t]
     ["control commands" (debian-bts-help-control) t]
     )
    ))

;;  - Add `fixed' `notfixed' `block' `unblock' `archive' `unarchive'
;;    `found' `notfound'.  (Closes: #391647)

(defvar debian-bts-control-font-lock-keywords
  '(("#.*$" .  font-lock-comment-face)
    ("^ *thank.*$" . font-lock-function-name-face)
    ("^ *\\(found\\) +\\(-?[0-9]+\\) *\\(.*\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-string-face))
    ("^ *\\(notfound\\) +\\(-?[0-9]+\\) +\\(.+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-string-face))
    ("^ *\\(archive\\) +\\(-?[0-9]+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face))
    ("^ *\\(unarchive\\) +\\(-?[0-9]+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face))
    ("^ *\\(block\\) +\\(-?[0-9]+\\) +\\(by\\) +\\(.+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-function-name-face)
     (4 font-lock-string-face))
    ("^ *\\(unblock\\) +\\(-?[0-9]+\\) +\\(by\\) +\\(.+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-function-name-face)
     (4 font-lock-string-face))
    ("^ *\\(fixed\\) +\\(-?[0-9]+\\) +\\(.+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-string-face))
    ("^ *\\(notfixed\\) +\\(-?[0-9]+\\) +\\(.+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-string-face))
    ("^ *\\(package\\)  +\\([a-z0-9\\.\\-]+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-keyword-face nil t))
    ("^ *\\(owner\\) +\\(-?[0-9]+\\) +\\(\\(!\\)\\|\\(.+\\)\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (4 font-lock-keyword-face nil t)
     (5 font-lock-string-face nil t))
    ("^ *\\(noowner\\) +\\(-?[0-9]+\\)"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face))
    ("^ *\\(reassign\\) +\\(-?[0-9]+\\) +\\([a-z0-9\\.\\-]+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-keyword-face nil t))
    ("^ *\\(reopen\\) +\\(-?[0-9]+\\) +\\(\\(!\\|=\\)\\|\\(.+\\)\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (4 font-lock-keyword-face nil t)
     (5 font-lock-string-face nil t))
    ("^ *\\(submitter\\) +\\(-?[0-9]+\\) +\\(\\(!\\)\\|\\(.+\\)\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (4 font-lock-keyword-face nil t)
     (5 font-lock-string-face nil t))
    ("^ *\\(forwarded\\) +\\(-?[0-9]+\\) +\\(.+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-string-face))
    ("^ *\\(notforwarded\\) +\\(-?[0-9]+\\)"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face))
    ("^ *\\(retitle\\) +\\(-?[0-9]+\\) +\\(.+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-string-face))
    ("^ *\\(severity\\) +\\(-?[0-9]+\\) +\\(\\(critical\\|grave\\|serious\\)\\|\\(important\\)\\|\\(normal\\)\\|\\(\\(minor\\)\\|\\(wishlist\\)\\)\\)"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (4 font-lock-warning-face nil t)
     (5 font-lock-keyword-name-face nil t)
     (6 font-lock-type-face nil t)
     (7 font-lock-string-face nil t))
    ("^ *\\(clone\\) +\\([0-9]+\\) +\\(-[0-9]+\\( +-[0-9]+\\)*\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-keyword-face))
    ("^ *\\(merge\\) +\\(-?[0-9]+ +-?[0-9]+\\( +-?[0-9]+\\)*\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-keyword-face))
    ("^ *\\(unmerge\\) +\\(-?[0-9]+\\)$"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face))
    ("^ *\\(tags\\) +\\(-?[0-9]+\\) +\\([-+=]? +\\)?\\(security\\)"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-keyword-face nil t)
     (4 font-lock-warning-face))
    ("^ *\\(tags\\) +\\(-?[0-9]+\\) +\\([-+=]? +\\)?\\(patch\\|wontfix\\|moreinfo\\|unreproducible\\|help\\|pending\\|fixed-in-experimental\\|fixed-upstream\\|fixed\\|security\\|upstream\\|confirmed\\|d-i\\|ipv6\\|lfs\\|l10n\\|potato\\|woody\\|sarge-ignore\\|sarge\\|etch-ignore\\|etch\\|sid\\|experimental\\)"
     (1 font-lock-function-name-face)
     (2 font-lock-type-face)
     (3 font-lock-keyword-face nil t)
     (4 font-lock-keyword-face))
    ("^ *\\(close\\) +\\(-?[0-9]+\\)$"
     (1 font-lock-warning-face)
     (2 font-lock-type-face)))
  "Regexp keywords to fontify `debian-bts-control' reports.")

(defun debian-bts-control-minor-mode (arg)
  "Toggle `debian-bts-control' mode.
A positive prefix argument ARG turns on `debian-bts-control' mode\;
a negative prefix argument turns it off.
\\
\\[debian-bts-control]\t\tAdd a control command to the current message."
  (interactive "P")
  (set (make-local-variable 'debian-bts-control-minor-mode)
       (if arg
           (> (prefix-numeric-value arg) 0)
         (not debian-bts-control-minor-mode)))
  (cond
   (debian-bts-control-minor-mode                 ;Setup the minor-mode
    (if (fboundp 'font-lock-add-keywords)
        (font-lock-add-keywords nil debian-bts-control-font-lock-keywords t))
    )))

;; Install ourselves:
(or (assq 'debian-bts-control-minor-mode minor-mode-alist)
    (setq minor-mode-alist
          (cons '(debian-bts-control-minor-mode " DBugC") minor-mode-alist)))
(or (assq 'debian-bts-control-minor-mode minor-mode-map-alist)
    (setq minor-mode-map-alist
          (cons (cons 'debian-bts-control-minor-mode
                      debian-bts-control-minor-mode-map)
                minor-mode-map-alist)))

(defvar debian-bts-control-alist
  '(("reassign") ("severity") ("reopen") ("submitter") ("forwarded")
    ("notforwarded") ("retitle") ("clone") ("merge") ("unmerge")
    ("tags") ("close") ("package") ("owner") ("noowner") ("found")
    ("notfound") ("fixed") ("notfixed") ("block") ("unblock") ("archive")
    ("unarchive"))
  "List of available commands at control@bugs.debian.org.")

(defun debian-bts-bug-number-at-point ()
  "Read #NNNNNN from current point."
  (let ((item (word-at-point)))
    (if (and item
	     (string-match "^[0-9]+[0-9]$" item))
	item)))

(defun debian-bts-control-prompt (prompt &optional number)
  "Prompt for bug number using sensible default if found."
  (let ((default-number number))
    (unless default-number
      (save-excursion
        (goto-char (point-min))
	(if (re-search-forward (concat "\\([0-9]+\\)@" debian-bts-emaildomain)
                               (mail-header-end) t)
	    (setq default-number (match-string-no-properties 1)))))
    (if default-number
        (read-string (format "%s [%s]: " prompt default-number)
                     nil nil default-number)
      (read-string (format "%s: " prompt)))))

;;;###autoload
(defun debian-bts-control (action &optional arg)
  "Contruct a message with initial ACTION command for control@bugs.debian.org.
Contructs a new control command line if called from within the message
being constructed.

If prefix arg is provided, use the current buffer instead instead of
creating a new outgoing email message buffer.
The current buffer is also used if the current major mode matches one listed
in `debian-bts-control-modes-to-reuse'."
  (interactive (list (completing-read "Command: "
                                      debian-bts-control-alist nil nil)
                     current-prefix-arg))
  (let ((number-default (debian-bts-bug-number-at-point)))
    (cond
     ((or arg
          (and (car (memq t (mapcar '(lambda (item) (eq item major-mode))
                                    debian-bts-control-modes-to-reuse)))
               (not debian-bts-control-minor-mode)))
      (debian-bug--set-CC debian-bts-emailaddress
			  (concat
			   (symbol-name debian-bts-control-cc-or-bcc) ":"))
      (goto-char (point-min))
      (if (re-search-forward (concat "\\([0-9]+\\)@" debian-bts-emaildomain)
                             (mail-header-end) t)
          (setq number-default (match-string 1)))
      (goto-char (mail-header-end))
      (forward-line 1)
      (if (looking-at "^<#secure")      ;Skip over mml directives
          (forward-line 1))
      (insert "thanks\n\n")
      (debian-bts-control-minor-mode 1))
     ((not debian-bts-control-minor-mode)
      (reporter-compose-outgoing)
      (if (and (equal mail-user-agent 'gnus-user-agent)
               (string-equal " *nntpd*" (buffer-name)))
          (set-buffer "*mail*"))   ; Bug in emacs21.1?  Moves to " *nntpd*"
      (goto-char (point-min))
      (cond
       ((re-search-forward "To: " nil t)
        (insert debian-bts-emailaddress))
       ((re-search-forward "To:" nil t)
        (insert " " debian-bts-emailaddress))
       (t
        (insert "To: " debian-bts-emailaddress)))
      (if debian-bug-use-From-address
          (debian-bug--set-custom-From))
      (if debian-bug-always-CC-myself
          (debian-bug--set-CC debian-bug-From-address "cc:"))
      (goto-char (mail-header-end))
      (forward-line 1)
      (if (looking-at "^<#secure")      ;Skip over mml directives
          (forward-line 1))
      (insert "thanks\n")
      (debian-bts-control-minor-mode 1)))
    (goto-char (mail-header-end))
    (if (re-search-forward "^thank" nil t)
        (beginning-of-line)
      (goto-char (point-max)))
    (cond
     ((string-equal "package" action)
      (debian-bug-fill-packages-obarray)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "package [ packagename ... ]

 Limits the following commands so that they will only apply to bugs
 filed against the listed packages. You can list one or more
 packages. If you don't list any packages, the following commands will
 apply to all bugs. You're encouraged to use this as a safety feature
 in case you accidentally use the wrong bug numbers.

"
                        ""))
             (package (completing-read
                       (concat verbose "Package list to limit to: ")
                       (debian-bug-fill-packages-obarray) nil nil)))
        (insert (format "package %s\n" package))))
     ((string-equal "reassign" action)
      (debian-bug-fill-packages-obarray)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "reassign bugnumber package

 Records that bug #BUGNUMBER is a bug in PACKAGE. This can be used to
 set the package if the user forgot the pseudo-header, or to change an
 earlier assignment. No notifications are sent to anyone (other than the
 usual information in the processing transcript).

"
                        "Package to reassign to: "))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number") 
			  number-default))
             (package (completing-read
                       (concat verbose "Package to reassign to: ")
                       (debian-bug-fill-packages-obarray) nil nil)))
        (insert (format "reassign %s %s\n" bug-number package))))
     ((string-equal "reopen" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "reopen bugnumber [ originator-address | = | ! ]

 Reopens #BUGNUMBER if it is closed.

 By default, or if you specify =, the original submitter will remain the
 originator of the report.

 The originator will be set to the optional address you supply. If you wish
 to become the new originator of the reopened report you can use the !
 shorthand or specify your own email address.

 If the bug is not closed then \"reopen\" won't do anything, not even change
 the originator. To change the originator of an open bug report, use the
 \"submitter\" command; note that this will inform the original submitter of
 the change.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (originator (read-string
                        (concat verbose "Originator-address (optional): "))))
        (insert (format "reopen %s %s\n" bug-number originator))))
     ((string-equal "submitter" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "submitter bugnumber originator-address | !

 Changes the originator of #BUGNUMBER to ORIGINATOR-ADDRESS.

 If you wish to become the new originator of the report you can use the
 ! shorthand or specify your own email address.

 While the reopen command changes the originator of other bugs merged
 with the one being reopened, submitter does not affect merged bugs.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (originator (read-string
                          (concat verbose "Originator-address (optional): "))))
        (insert (format "submitter %s %s\n" bug-number originator))))
     ((string-equal "owner" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "owner bugnumber address | !

 Sets address to be the \"owner\" of #bugnumber. The owner of a bug
 claims responsibility for fixing it and will receive all mail
 regarding it. This is useful to share out work in cases where a
 package has a team of maintainers.

 If you wish to become the owner of the bug yourself, you can use the
 ! shorthand or specify your own email address.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (address (read-string
                       (concat verbose "address (optional): "))))
        (insert (format "owner %s %s\n" bug-number address))))
     ((string-equal "noowner" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "noowner bugnumber

 Forgets any idea that the bug has an owner other than the usual
 maintainer. If the bug had no owner recorded then this will do
 nothing.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default)))
        (insert (format "noowner %s\n" bug-number))))
     ((string-equal "forwarded" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "forwarded bugnumber address

 Notes that BUGNUMBER has been forwarded to the upstream maintainer at
 ADDRESS. This does not actually forward the report. This can be used to
 change an existing incorrect forwarded-to address, or to record a new
 one for a bug that wasn't previously noted as having been forwarded.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (address (read-string
                       (concat verbose "Forwarded-address: "))))
        (insert (format "forwarded %s %s\n" bug-number address))))
     ((string-equal "notforwarded" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "notforwarded bugnumber

 Forgets any idea that BUGNUMBER has been forwarded to any upstream
 maintainer. If the bug was not recorded as having been forwarded then
 this will do nothing.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default)))
        (insert (format "notforwarded %s\n" bug-number))))
     ((string-equal "retitle" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "retitle bugnumber new-title

 Changes the TITLE of a bug report to that specified (the default is the
 Subject mail header from the original report).

 Unlike most of the other bug-manipulation commands, when used on one of
 a set of merged reports this will change the title of only the
 individual bug requested, and not all those with which it is merged.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (title (read-string
                     (concat verbose "New title: "))))
        (insert (format "retitle %s %s\n" bug-number title))))
     ((string-equal "severity" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "severity bugnumber severity

 Set the severity level for bug report #BUGNUMBER to SEVERITY. No
 notification is sent to the user who reported the bug.

 Severities are critical, grave, serious, important, normal, minor, and
 wishlist.

 For their meanings, consult the Control->Help->Severities menu.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (severity (completing-read "Severity: " debian-bug-severity-alist
                                        nil t)))
        (insert (format "severity %s %s\n" bug-number severity))))
     ((string-equal "clone" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "clone bugnumber [ new IDs ]

 Duplicate a bug report. Useful when a single report indicates that
 multiple distinct bugs have occured. \"New IDs\" are negative numbers,
 separated by spaces, which may be used in subsequent control commands to
 refer to the newly duplicated bugs.
   Example usage:
     clone 12345 -1 -2
     reassign -1 foo
     retitle -1 foo: foo sucks
     reassign -2 bar
     retitle -2 bar: bar sucks when used with foo
     severity -2 wishlist
"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (ids (read-string (concat verbose "New IDs (e.g. -1 -2): "))))
        (insert (format "clone %s %s\n" bug-number ids))))
     ((string-equal "merge" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "merge bugnumber bugnumber ...

 Merges two or more bug reports. When reports are merged, opening, closing,
 marking or unmarking as forwarded and reassigning any of the bugs to a new
 package will have an identical effect on all of the merged reports.

 Before bugs can be merged they must be in exactly the same state.

"
                        ""))
             (bug-numbers (read-string (concat verbose "All bug numbers: "))))
        (insert (format "merge %s\n" bug-numbers))))
     ((string-equal "unmerge" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "unmerge bugnumber

 Disconnects a bug report from any other reports with which it may have
 been merged. If the report listed is merged with several others then
 they are all left merged with each other; only their associations with
 the bug explicitly named are removed.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default)))
        (insert (format "unmerge %s\n" bug-number))))
     ((string-equal "tags" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "tags bugnumber [ + | - | = ] tag

 Sets a particular tag for the bug report #BUGNUMBER to tag. No
 notification is sent to the user who reported the bug. + means adding, -
 means subtracting, and = means ignoring the current tags and setting them
 afresh. The default action is adding.

 Tags are patch, wontfix, moreinfo, unreproducible, help, pending, fixed,
 fixed-in-experimental, fixed-upstream, security, upstream, confirmed, d-i,
 ipv6, lfs, l10n, potato, woody, sarge, sarge-ignore, etch, etch-ignore,
 sid, and experimental.

 For their meanings, consult the Control->Help->Tags menu.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (add (completing-read "+, -, = (default +): "
                                   '(("+") ("-") ("=")) nil t nil nil "+"))
             (tag (completing-read "Tag: " debian-bug-alltags-alist nil t)))
        (insert (format "tags %s %s %s\n" bug-number add tag))))
     ((string-equal "close" action)
      (if (yes-or-no-p
           (concat "Deprecated in favor of #BUG-close@" 
                   debian-bts-emaildomain ". Continue? "))
          (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                              "close bugnumber

 Close bug report #BUGNUMBER.

 A notification is sent to the user who reported the bug, but (in contrast
 to mailing bugnumber-done@bugs) the text of the mail which caused the bug
 to be closed is not included in that notification. The maintainer who
 closes a report needs to ensure, probably by sending a separate message,
 that the user who reported the bug knows why it is being closed. The use of
 this command is therefore deprecated.

"
                            ""))
                 (bug-number (debian-bts-control-prompt
                              (concat verbose "Bug number")
			      number-default)))
            (insert (format "close %s\n" bug-number)))))
     ((string-equal "found" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "found bugnumber [version]

    Record that #bugnumber has been encountered in the given
    version of the package to which it is assigned.

    The BTS considers a bug to be open when it has no fixed
    version, or when it has been found more recently than it has
    been fixed.

    If no version is given, then the list of fixed versions for
    the bug is cleared. This is identical to the behaviour of
    reopen.

    This command will only cause a bug to be marked as not done
    if no version is specified, or if the version being marked
    found is equal to the version which was last marked
    fixed. (If you are certain that you want the bug marked as
    not done, use reopen in conjunction with found.)

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (version (read-string (concat verbose "Version (if any): "))))
        (insert (format "found %s %s\n" bug-number version))))
     ((string-equal "notfound" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "notfound bugnumber version

    Remove the record that #bugnumber was encountered in the
    given version of the package to which it is assigned.

    This differs from closing the bug at that version in that the
    bug is not listed as fixed in that version either; no
    information about that version will be known. It is intended
    for fixing mistakes in the record of when a bug was found.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (version (read-string (concat verbose "Version: "))))
        (insert (format "notfound %s %s\n" bug-number version))))
     ((string-equal "fixed" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "fixed bugnumber version

    Indicate that bug #bugnumber was fixed in the given version
    of the package to which it is assigned.

    This does not cause the bug to be marked as closed, it merely
    adds another version in which the bug was fixed. Use the
    bugnumber-done address to close a bug and mark it fixed in a
    particular version.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (version (read-string (concat verbose "Version: "))))
        (insert (format "fixed %s %s\n" bug-number version))))
     ((string-equal "notfixed" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "notfixed bugnumber  version

    Remove the record that bug #bugnumber has been fixed in the
    given version.

    This command is equivalent to found followed by notfound (the
    found removes the fixed at a particular version, and notfound
    removes the found.)

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (version (read-string (concat verbose "Version: "))))
        (insert (format "notfixed %s %s\n" bug-number version))))
     ((string-equal "block" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "block bugnumber by  bug ...

    Note that the fix for the first bug is blocked by the other
    listed bugs.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (by-bug (read-string (concat verbose "by bug number(s): "))))
        (insert (format "block %s by %s\n" bug-number by-bug))))
     ((string-equal "unblock" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "nblock bugnumber  by bug ...
    Note that the fix for the first bug is no longer blocked by the other listed bugs.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default))
             (by-bug (read-string (concat verbose "by bug number(s): "))))
        (insert (format "unblock %s by %s\n" bug-number by-bug))))
     ((string-equal "archive" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "archive bugnumber

    Archives a bug that had been archived at some point in the
    past but is currently not archived if the bug fulfills the
    requirements for archival, ignoring time.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default)))
        (insert (format "archive %s\n" bug-number))))
     ((string-equal "unarchive" action)
      (let* ((verbose (if debian-bts-control-verbose-prompts-flag
                          "unarchive bugnumber

    Unarchives a bug that was previously archived. Unarchival
    should generally be coupled with reopen and found/fixed as
    appropriate. Bugs that have been unarchived can be archived
    using archive assuming the non-time based archival
    requirements are met.

"
                        ""))
             (bug-number (debian-bts-control-prompt
                          (concat verbose "Bug number")
			  number-default)))
        (insert (format "unarchive %s\n" bug-number))))
     )))


(defun debian-bts-help-control ()
  (with-output-to-temp-buffer "*Help*"
    (princ
     "reassign bugnumber package

    Records that bug #bugnumber is a bug in package. This can be used to
    set the package if the user forgot the pseudo-header, or to change an
    earlier assignment. No notifications are sent to anyone (other than the
    usual information in the processing transcript).

reopen bugnumber [ originator-address | = | ! ]

    Reopens #bugnumber if it is closed.

    By default, or if you specify =, the original submitter is still as the
    originator of the report, so that they will get the ack when it is
    closed again.

    If you supply an originator-address the originator will be set to the
    address you supply. If you wish to become the new originator of the
    reopened report you can use the ! shorthand or specify your own email
    address.

    It is usually a good idea to tell the person who is about to be
    recorded as the originator that you're reopening the report, so that
    they will know to expect the ack which they'll get when it is closed
    again.

    If the bug is not closed then reopen won't do anything, not even change
    the originator. To change the originator of an open bug report, use the
    submitter command; note that this will inform the original submitter of
    the change.

found bugnumber [ version ]

    Record that #bugnumber has been encountered in the given
    version of the package to which it is assigned.

    The bug tracking system uses this information, in conjunction
    with fixed versions recorded when closing bugs, to display
    lists of bugs open in various versions of each package. It
    considers a bug to be open when it has no fixed version, or
    when it has been found more recently than it has been fixed.

    If no version is given, then the list of fixed versions for
    the bug is cleared. This is identical to the behaviour of
    reopen.

    This command will only cause a bug to be marked as not done
    if no version is specified, or if the version being marked
    found is equal to the version which was last marked
    fixed. (If you are certain that you want the bug marked as
    not done, use reopen in conjunction with found.)

    This command was introduced in preference to reopen because
    it was difficult to add a version to that command's syntax
    without suffering ambiguity.

notfound bugnumber version

    Remove the record that #bugnumber was encountered in the
    given version of the package to which it is assigned.

    This differs from closing the bug at that version in that the
    bug is not listed as fixed in that version either; no
    information about that version will be known. It is intended
    for fixing mistakes in the record of when a bug was found.

fixed bugnumber version

    Indicate that bug #bugnumber was fixed in the given version
    of the package to which it is assigned.

    This does not cause the bug to be marked as closed, it merely
    adds another version in which the bug was fixed. Use the
    bugnumber-done address to close a bug and mark it fixed in a
    particular version.

notfixed bugnumber version

    Remove the record that bug #bugnumber has been fixed in the given version.

    This command is equivalent to found followed by notfound (the found removes the fixed at a particular version, and notfound removes the found.)

submitter bugnumber originator-address | !

    Changes the originator of #bugnumber to originator-address.

    If you wish to become the new originator of the report you can use the
    ! shorthand or specify your own email address.

    While the reopen command changes the originator of other bugs merged
    with the one being reopened, submitter does not affect merged bugs.

forwarded bugnumber address

    Notes that bugnumber has been forwarded to the upstream maintainer at
    address. This does not actually forward the report. This can be used to
    change an existing incorrect forwarded-to address, or to record a new
    one for a bug that wasn't previously noted as having been forwarded.

notforwarded bugnumber

    Forgets any idea that bugnumber has been forwarded to any upstream
    maintainer. If the bug was not recorded as having been forwarded then
    this will do nothing.

retitle bugnumber new-title

    Changes the title of a bug report to that specified (the default is the
    Subject mail header from the original report.

    Unlike most of the other bug-manipulation commands when used on one of
    a set of merged reports this will change the title of only the
    individual bug requested, and not all those with which it is merged.

severity bugnumber severity

    Set the severity level for bug report #bugnumber to severity. No
    notification is sent to the user who reported the bug.

    Severities are critical, grave, serious, important, normal, minor, and
    wishlist.

    For their meanings please consult the general developers' documentation
    for the bug system.

clone bugnumber [ new IDs ]

    The clone control command allows you to duplicate a bug report. It is
    useful in the case where a single report actually indicates that
    multiple distinct bugs have occured. \"New IDs\" are negative numbers,
    separated by spaces, which may be used in subsequent control commands
    to refer to the newly duplicated bugs. A new report is generated for
    each new ID.

    Example usage:

        clone 12345 -1 -2
        reassign -1 foo
        retitle -1 foo: foo sucks
        reassign -2 bar
        retitle -2 bar: bar sucks when used with foo
        severity -2 wishlist
        clone 123456 -2
        reassign -2 foo
        retitle -2 foo: foo sucks
        merge -1 -2


merge bugnumber bugnumber ...

    Merges two or more bug reports. When reports are merged, opening,
    closing, marking or unmarking as forwarded and reassigning any of the
    bugs to a new package will have an identical effect on all of the
    merged reports.

    Before bugs can be merged they must be in exactly the same state:
    either all open or all closed, with the same forwarded-to upstream
    author address or all not marked as forwarded, all assigned to the same
    package or package(s) (an exact string comparison is done on the
    package to which the bug is assigned), and all of the same severity. If
    they don't start out in the same state you should use reassign, reopen
    and so forth to make sure that they are before using merge.

    If any of the bugs listed in a merge command is already merged with
    another bug then all the reports merged with any of the ones listed
    will all be merged together. Merger is like equality: it is reflexive,
    transitive and symmetric.

    Merging reports causes a note to appear on each report's logs; on the
    WWW pages this is includes links to the other bugs.

    Merged reports are all expired simultaneously, and only when all of the
    reports each separately meet the criteria for expiry.

unmerge bugnumber

    Disconnects a bug report from any other reports with which it may have
    been merged. If the report listed is merged with several others then
    they are all left merged with each other; only their associations with
    the bug explicitly named are removed.

    If many bug reports are merged and you wish to split them into two
    separate groups of merged reports you must unmerge each report in one
    of the new groups separately and then merge them into the required new
    group.

    You can only unmerge one report with each unmerge command; if you want
    to disconnect more than one bug simply include several unmerge commands
    in your message.

tags bugnumber [ + | - | = ] tag

    Sets a particular tag for the bug report #bugnumber to tag. No
    notification is sent to the user who reported the bug. + means adding,
    - means subtracting, and = means ignoring the current tags and setting
    them afresh. The default action is adding.

    Available tags currently include patch, wontfix, moreinfo,
    unreproducible, help, pending, fixed, security, upstream, fixed-upstream,
    potato, woody, sarge, sarge-ignore, sid and experimental.

    For their meanings, consult the Control->Help->Tags menu.

block bugnumber by  bug ...

    Note that the fix for the first bug is blocked by the other
    listed bugs.

unblock bugnumber by bug ...

    Note that the fix for the first bug is no longer blocked by
    the other listed bugs.

close bugnumber

    Close bug report #bugnumber.

    A notification is sent to the user who reported the bug, but (in
    contrast to mailing bugnumber-done@bugs) the text of the mail which
    caused the bug to be closed is not included in that notification. The
    maintainer who closes a report needs to ensure, probably by sending a
    separate message, that the user who reported the bug knows why it is
    being closed. The use of this command is therefore deprecated.

package [ packagename ... ]

    Limits the following commands so that they will only apply to bugs
    filed against the listed packages. You can list one or more packages. If
    you don't list any packages, the following commands will apply to all
    bugs. You're encouraged to use this as a safety feature in case you
    accidentally use the wrong bug numbers.

    Example usage:

        package foo
        reassign 123456 bar

        package bar
        retitle 123456 bar: bar sucks
        severity 123456 normal

        package
        severity 234567 wishlist

owner bugnumber address | !

    Sets address to be the \"owner\" of #bugnumber. The owner of a bug
    claims responsibility for fixing it and will receive all mail
    regarding it. This is useful to share out work in cases where a
    package has a team of maintainers.

    If you wish to become the owner of the bug yourself, you can use
    the ! shorthand or specify your own email address.

noowner bugnumber

    Forgets any idea that the bug has an owner other than the usual
    maintainer. If the bug had no owner recorded then this will do
    nothing.

archive bugnumber

    Archives a bug that had been archived at some point in the
    past but is currently not archived if the bug fulfills the
    requirements for archival, ignoring time.

unarchive bugnumber

    Unarchives a bug that was previously archived. Unarchival
    should generally be coupled with reopen and found/fixed as
    appropriate. Bugs that have been unarchived can be archived
    using archive assuming the non-time based archival
    requirements are met.

quit
stop
thank...
--...

    Tells the control server to stop processing the message; the remainder
    of the message can include explanations, signatures or anything else,
    none of it will be detected by the control server.

#...

    One-line comment. The # must be at the start of the line.

Help text from http://www.debian.org/Bugs/server-control, Apr 22nd 2003.
Copyright 1999 Darren O. Benham, 1994-1997 Ian Jackson,
 1997 nCipher Corporation Ltd.")))

;;;###autoload
(defun emacs-bts-control (action &optional arg)
  "Contruct a message with ACTION command for control@debbugs.gnu.org.
Contructs a new control command line if called from within the message
being constructed.

If prefix arg is provided, use the current buffer instead instead of
creating a new outgoing email message buffer.
The current buffer is also used if the current major mode matches one listed
in `debian-bts-control-modes-to-reuse'."
  (interactive (list (completing-read "Command: "
                                      debian-bts-control-alist nil nil)
                     current-prefix-arg))
  (let ((debian-bts-emailaddress "control@debbugs.gnu.org")
         (debian-bts-emaildomain "debbugs.gnu.org")
         (debian-bts-control-for-emacs t))
    (debian-bts-control action arg)))

(provide 'debian-bts-control)

;;; debian-bts-control.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/dpkg-dev-el/debian-copyright.el0000775000000000000000000000673012230377265022010 0ustar  ;;; debian-copyright.el --- Major mode for Debian package copyright files

;; Copyright 2002, 2003 Junichi Uekawa.

;; This file 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 2, or (at your option)
;; any later version.
;;
;; debian-copyright.el 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 your Debian installation, in /usr/share/common-licenses/GPL
;; If not, write to the Free Software Foundation, 675 Mass Ave,
;; Cambridge, MA 02139, USA.


(require 'debian-changelog-mode)

;;; Code:

(defgroup debian-copyright nil "Debian copyright mode"
  :group 'tools
  :prefix "debian-copyright-")

(defcustom debian-copyright-mode-load-hook nil
  "*Hooks that are run when `debian-copyright-mode' is loaded."
  :group 'debian-copyright
  :type 'hook)
  
(defcustom debian-copyright-mode-hook nil
  "Normal hook run when entering Debian Copyright mode."
  :group 'debian-copyright
  :type 'hook
  :options '(turn-on-auto-fill flyspell-mode))

(defconst debian-copyright-mode-version "$Id: debian-copyright.el,v 1.5 2010-07-28 15:33:45 psg Exp $" "Version of debian copyright mode.")

(defvar debian-copyright-mode-map nil
  "Keymap for debian/copyright mode.")
(defvar debian-copyright-mode-syntax-table nil
  "Syntax table for debian/copyright mode.")

(defvar debian-copyright-font-lock-keywords nil
  "Regexps to highlight in font-lock.")

(if debian-copyright-mode-syntax-table
         ()              ; Do not change the table if it is already set up.
       (setq debian-copyright-mode-syntax-table (make-syntax-table))
       (modify-syntax-entry ?\" ".   " debian-copyright-mode-syntax-table)
       (modify-syntax-entry ?\\ ".   " debian-copyright-mode-syntax-table)
       (modify-syntax-entry ?' "w   " debian-copyright-mode-syntax-table))

;;;###autoload
(defun debian-copyright-mode ()
  "Mode to edit and read debian/copyright.
\\{debian-copyright-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'debian-copyright-mode)
  (setq mode-name "debian/copyright")
  (mapcar 'make-local-variable '(font-lock-defaults write-file-hooks))
  (use-local-map debian-copyright-mode-map)
  (set-syntax-table debian-copyright-mode-syntax-table)
  (if (or (not (featurep 'goto-addr))
          (not goto-address-highlight-p))
      (setq debian-copyright-font-lock-keywords
            '(("http:.*$" . font-lock-function-name-face)
              ("ftp:.*$" . font-lock-function-name-face)
              ("^Copyright:$" . font-lock-keyword-face)))
    (setq debian-copyright-font-lock-keywords
          '(("^Copyright:$" . font-lock-keyword-face)))
    (goto-address))
  (setq font-lock-defaults
        '(debian-copyright-font-lock-keywords
          nil		;keywords-only
          nil		;case-fold
          ()		;syntax-alist
          ))
  (run-hooks 'debian-copyright-mode-hook))


;;;###autoload
(add-to-list 'auto-mode-alist
             '("debian/.*copyright\\'" . debian-copyright-mode))
;;;###autoload
(add-to-list 'auto-mode-alist
             '("\\`/usr/share/doc/.*/copyright" . debian-copyright-mode))

(run-hooks 'debian-copyright-mode-load-hook)

(provide 'debian-copyright)

;;; debian-copyright.el ends here
emacs-goodies-el-35.8ubuntu2/elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.make0000775000000000000000000000037212230377265022747 0ustar  emacs -batch --no-site-file --multibyte --eval '(setq load-path (cons "." load-path))' -l autoload --eval '(setq generated-autoload-file (expand-file-name "dpkg-dev-el-loaddefs.el"))' --eval '(setq make-backup-files nil)' -f batch-update-autoloads .
emacs-goodies-el-35.8ubuntu2/elisp/dpkg-dev-el/readme-debian.el0000775000000000000000000001153612230377265021235 0ustar  ;;; readme-debian.el --- a simple mode for README.Debian files

;; Copyright 2002, 2003, 2006 Junichi Uekawa.
;;
;; This file 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 2, or (at your option)
;; any later version.
;;
;; readme-debian.el 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 your Debian installation, in /usr/share/common-licenses/GPL
;; If not, write to the Free Software Foundation, 675 Mass Ave,
;; Cambridge, MA 02139, USA.

;;; Code:
(require 'debian-changelog-mode)
(defgroup readme-debian nil "Readme Debian (mode)"
  :group 'tools
  :prefix "readme-debian-")

(defcustom readme-debian-mode-load-hook nil "*Hooks that are run when `readme-debian-mode' is loaded."
  :type 'hook
  :group 'readme-debian)
(defcustom readme-debian-mode-hook nil "*Hooks that are run when `readme-debian-mode' is entered."
  :type 'hook
  :group 'readme-debian)

(defvar readme-debian-font-lock-keywords
  '(("^\\(.*\\) for \\(Debian\\)$"
     (1 font-lock-keyword-face)
     (2 font-lock-string-face))
    ("^[-=]+$" 0 font-lock-string-face)
    ("^ -- \\([^<]*\\)\\(<[^>]*>\\)\\(, \\(.*\\)\\)?$"
     (1 font-lock-keyword-face)
     (2 font-lock-function-name-face)
     (3 font-lock-string-face)))
  "Regexp keywords used to fontify README.Debian buffers.")

(defun readme-debian-date-string ()
  "Return RFC-822 format date string."
  ;; this function could be simpler if xemacs supported %z, but
  ;; it doesn't, so we're shelling out to invoke date -R to obtain
  ;; Debian-policy-compliant date string.
  (let* ((date-program "date -R")
	 (system-time-locale "C"))
    (if (featurep 'xemacs)
	(replace-in-string (exec-to-string date-program) "\n" "")
      ;; if it's not xemacs, just use format-time-string
      (format-time-string "%a, %e %b %Y %T %z" (current-time)))))

(defun readme-debian-update-timestamp ()
  "Function to update timestamp in README.Debian files, automatically invoked when saving file."
  (save-excursion
    (goto-line 1)
    (if (re-search-forward "^ -- " nil t)
        (delete-region (progn (beginning-of-line) (point)) (progn (end-of-line) (point)))
      (goto-char (point-max))
      (if (bolp)
	  (insert "\n")
	(insert "\n\n")))
    (insert (concat
	     " -- "
	     debian-changelog-full-name
	     " <" debian-changelog-mailing-address ">, "
             (readme-debian-date-string)))
    (if (and (= (point)(point-max)) (not (bolp)))
	(insert "\n"))))

(defvar readme-debian-mode-map nil "Keymap for README.Debian mode.")
(if readme-debian-mode-map
    ()
  (setq readme-debian-mode-map (make-sparse-keymap)))
(defvar readme-debian-mode-syntax-table nil "Syntax table for README.Debian mode.")
(if readme-debian-mode-syntax-table
    ()                   ; Do not change the table if it is already set up.
  (setq readme-debian-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry ?\" ".   " readme-debian-mode-syntax-table)
  (modify-syntax-entry ?\\ ".   " readme-debian-mode-syntax-table)
  (modify-syntax-entry ?' "w   " readme-debian-mode-syntax-table))

(defvar font-lock-defaults)             ;For XEmacs byte-compilation
;;;###autoload
(defun readme-debian-mode ()
  "Mode for reading and editing README.Debian files.
Upon saving the visited README.Debian file, the timestamp at the bottom
will be updated.

\\{readme-debian-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'readme-debian-mode)
  (setq mode-name "README.Debian")
  (make-local-variable 'font-lock-defaults)
  (use-local-map readme-debian-mode-map)
  (set-syntax-table readme-debian-mode-syntax-table)
  (setq font-lock-defaults
   '(readme-debian-font-lock-keywords
     nil ;; keywords-only? No, let it do syntax via table.
     nil ;; case-fold?
     nil ;; Local syntax table.
     ))
  ;; add timestamp update func to write-contents-hooks
  (if (or (= emacs-major-version 20)
          (string-match "XEmacs" emacs-version))
      (make-local-hook 'write-contents-hooks))
  (add-hook 'write-contents-hooks 'readme-debian-update-timestamp
	       nil t)
  (run-hooks 'readme-debian-mode-hook))

(add-to-list 'auto-mode-alist
             '("debian/.*README.*Debian$" . readme-debian-mode))
(add-to-list 'auto-mode-alist
             '("^/usr/share/doc/.*/README.*Debian.*$" . readme-debian-mode))
;;;###autoload(add-to-list 'auto-mode-alist '("debian/.*README.*Debian$" . readme-debian-mode))
;;;###autoload(add-to-list 'auto-mode-alist '("^/usr/share/doc/.*/README.*Debian.*$" . readme-debian-mode))

(run-hooks 'readme-debian-mode-load-hook)

(provide 'readme-debian)

;;; readme-debian.el ends here
emacs-goodies-el-35.8ubuntu2/debian/0000775000000000000000000000000012323027262014224 5ustar  emacs-goodies-el-35.8ubuntu2/debian/rules0000775000000000000000000000336112230377266015320 0ustar  #!/usr/bin/make -f
# Sample debian/rules that uses debhelper.
# GNU copyright 1997 to 1999 by Joey Hess.

# Uncomment this to turn on verbose mode.
#export DH_VERBOSE=1

include /usr/share/quilt/quilt.make

configure: configure-stamp
configure-stamp:
	dh_testdir
	touch configure-stamp

#build: patch configure-stamp build-stamp
build: configure-stamp build-stamp
build-stamp:
	dh_testdir
	dh_quilt_patch
	for i in debian/*.emacsen-install.in ; do cat $$i debian/emacsen-install.template > debian/$$(basename $$i .in) ; done
	for i in debian/*.emacsen-remove.in ; do cat $$i debian/emacsen-remove.template > debian/$$(basename $$i .in) ; done
	install -d info
	makeinfo elisp/emacs-goodies-el/emacs-goodies-el.texi
	makeinfo elisp/debian-el/debian-el.texi
	makeinfo elisp/emacs-goodies-el/maplev.texi
	mv -f maplev info/
	touch build-stamp

#clean: unpatch
clean:
	dh_testdir
	dh_testroot
	dh_quilt_unpatch
#	if [ -d debian/patched ] ; then rmdir debian/patched ; fi
	rm -f build-stamp configure-stamp
	for i in debian/*.emacsen-install.in ; do rm -f debian/$$(basename $$i .in) ; done
	for i in debian/*.emacsen-remove.in ; do rm -f debian/$$(basename $$i .in) ; done
	rm -fR info
	dh_clean

install: build
	dh_testdir
	dh_testroot
	dh_prep
	dh_installdirs
	dh_install

binary-arch:

binary-indep: build install
	dh_testdir
	dh_testroot
	dh_installdocs
	dh_installemacsen
	(cd debian/debian-el/etc/emacs/site-start.d; mv 50debian-el.el 51debian-el.el)
	dh_installinfo -p emacs-goodies-el info/emacs-goodies-el* info/maplev
	dh_installinfo -p debian-el info/debian-el
	dh_installchangelogs
	dh_compress
	dh_fixperms
	dh_installdeb
	dh_gencontrol
	dh_md5sums
	dh_builddeb

binary: binary-indep
.PHONY: build clean binary-indep binary-arch binary install configure patch unpatch
emacs-goodies-el-35.8ubuntu2/debian/compat0000775000000000000000000000000212230377266015436 0ustar  7
emacs-goodies-el-35.8ubuntu2/debian/debian-el.emacsen-startup0000775000000000000000000000121612230377266021115 0ustar  ;; -*-emacs-lisp-*-
;;
;; Emacs startup file for the Debian GNU/Linux devscripts-el package

(cond
 ((not (file-exists-p "/usr/share/emacs/site-lisp/debian-el"))
  (message "Package debian-el removed but not purged.  Skipping setup."))
 ((not (file-exists-p (concat "/usr/share/"
                              (symbol-name debian-emacs-flavor)
                              "/site-lisp/debian-el/preseed.elc")))
  (message "Package debian-el not fully installed.  Skipping setup."))
 (t
  (debian-pkg-add-load-path-item
   (concat "/usr/share/"
           (symbol-name debian-emacs-flavor)
           "/site-lisp/debian-el"))
  
  (require 'debian-el)))
emacs-goodies-el-35.8ubuntu2/debian/dpkg-dev-el.install0000775000000000000000000000105012230377266017723 0ustar  elisp/dpkg-dev-el/debian-bts-control.el /usr/share/emacs/site-lisp/dpkg-dev-el/
elisp/dpkg-dev-el/debian-changelog-mode.el /usr/share/emacs/site-lisp/dpkg-dev-el/
elisp/dpkg-dev-el/debian-control-mode.el /usr/share/emacs/site-lisp/dpkg-dev-el/
elisp/dpkg-dev-el/debian-copyright.el /usr/share/emacs/site-lisp/dpkg-dev-el/
elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.el /usr/share/emacs/site-lisp/dpkg-dev-el/
elisp/dpkg-dev-el/dpkg-dev-el.el /usr/share/emacs/site-lisp/dpkg-dev-el/
elisp/dpkg-dev-el/readme-debian.el /usr/share/emacs/site-lisp/dpkg-dev-el/
emacs-goodies-el-35.8ubuntu2/debian/debview.emacsen-startup0000775000000000000000000000025512230377266020724 0ustar  ;; This file may be safely deleted.
;;
;; Its only purpose was to remove the old version of this file that existed
;; prior to debview.el's move to the package `debian-el'.
emacs-goodies-el-35.8ubuntu2/debian/debian-el.postinst0000775000000000000000000000067712230377266017677 0ustar  #!/bin/sh
# Remove old /etc/50debian-el file that may still be on systems from
# previous versions of debian-el
set -e

case "$1" in
    configure)

        if [ -f /etc/emacs/site-start.d/50debian-el ]; then 
            rm -f /etc/emacs/site-start.d/50debian-el
        fi
        ;;

    abort-upgrade|abort-remove|abort-deconfigure)
        ;;
    *)
        echo "postinst called with unknown argument \`$1'" >&2
        ;;
esac

#DEBHELPER#
emacs-goodies-el-35.8ubuntu2/debian/changelog0000664000000000000000000036535512323027260016115 0ustar  emacs-goodies-el (35.8ubuntu2) trusty; urgency=medium

  * Default to emacs24, to remove emacs23 from main.

 -- Dimitri John Ledkov   Mon, 14 Apr 2014 19:53:36 +0100

emacs-goodies-el (35.8ubuntu1) trusty; urgency=low

  * Merge from Debian unstable.  Remaining changes:
    - debian-changelog-mode.el: Teach about Ubuntu releases.

 -- Iain Lane   Fri, 22 Nov 2013 12:03:05 +0000

emacs-goodies-el (35.8) unstable; urgency=low

  * vm-bonus-el:
  - Bug fix: "fails to install: ERROR: install script from vm-bonus-el
    package failed", thanks to Andreas Beckmann (Closes: #706746).  Drop
    the addition of /usr/share/emacs/site-lisp/vm to the compilation
    load-path.

 -- Peter S Galbraith   Fri, 18 Oct 2013 20:01:49 -0400

emacs-goodies-el (35.7) unstable; urgency=low

  * vm-bonus-el:
  - Bug fix: "fails to install: ERROR: install script from vm-bonus-el
    package failed", thanks to Andreas Beckmann (Closes: #706746).  Can't
    builf vm-bonus-el using "-q -no-site-file" because we need to load vm
    correctly.

 -- Peter S Galbraith   Thu, 17 Oct 2013 12:33:18 -0400

emacs-goodies-el (35.6) unstable; urgency=low

  * emacs-goodies-el:
  - Update to latest available version:
    ascii.el
    folding.el
    matlab.el
    minibuffer-complete-cycle.el (not updated; compilation errors)
    rfcview.el
  * vm-bonus-el  
  - Bug fix: "fails to install: ERROR: install script from vm-bonus-el
    package failed", thanks to Andreas Beckmann (Closes: #706746, 709962).
  * gnus-bonus-el binary package removed.  I don't use it and several
    people have offered to take it up in the past and never have.

 -- Peter S Galbraith   Tue, 15 Oct 2013 15:23:33 -0400

emacs-goodies-el (35.5) unstable; urgency=low

  * emacs-goodies-el:
  - Bug fix: "quack.el is out of date, upgrade to latest.", thanks to
    Mehul Sanghvi (Closes: #720890).
  - Bug fix: "tlc.el auto-mode-alist dot form", thanks to Kevin Ryde
    (Closes: #699389).
  - Bug fix: "please update markdown-mode", thanks to
    yoh@onerussian.com; (Closes: #695299).
  * dpkg-dev-el:
  - Bug fix: "Unable to add field "DM-Upload-Allowed", thanks to Kan-Ru
    Chen (Closes: #652424).

 -- Peter S Galbraith   Tue, 15 Oct 2013 13:43:58 -0400

emacs-goodies-el (35.4ubuntu1) saucy; urgency=low

  * Merge from Debian unstable.  Remaining changes:
    - debian-changelog-mode.el: Teach about Ubuntu releases.

 -- Iain Lane   Tue, 07 May 2013 13:25:53 +0100

emacs-goodies-el (35.4) unstable; urgency=low

  * Bug fix: emacsen-install.template: "fails to install due to heredoc
    failing; lazy evaluation and parentheses the culprit?", thanks to
    Daniel Dickinson (Closes: #701952).

 -- Peter S Galbraith   Sun, 03 Mar 2013 12:28:13 -0500

emacs-goodies-el (35.3) unstable; urgency=low

  * Bug fix: "egocentric.el and emacs24: "make-local-hook" is obsolete",
    thanks to Paul. Changed in ascii.el, egocentric.el, maplev.el via
    quilt patch 56_make_local_hook.diff. (Closes: #692750)
  * Bug fix: "wrong "Vcs-Cvs"; field value => debcheckout doesn't", thanks
    to Samuel Bronson.  Edited debian/control as proposed (Closes: #691987).
  * Bug fix: "Improve muttrc auto-mode pattern", thanks to Rafael
    Laboissiere. Patch applied to emacs-goodies-el.el (Closes: #645591).
  * Bug fix: "tlc mode's auto-mode-alist pattern should end \\'; not $",
    thanks to Reuben Thomas. Fixed without a quilt patch since I had
    already edited that file (Closes: #616166).

 -- Peter S Galbraith   Fri, 25 Jan 2013 13:43:51 -0500

emacs-goodies-el (35.2+nmu1ubuntu2) saucy; urgency=low

  * debian-changelog-mode.el: Update for current list of supported releases
    and remove "-proposed" since people should just be uploading to the bare
    release now.

 -- Iain Lane   Fri, 26 Apr 2013 18:03:27 +0100

emacs-goodies-el (35.2+nmu1ubuntu1) raring; urgency=low

  * Merge from Debian unstable. Remaining changes:
    - Add {hardy,jaunty,karmic,lucid,maverick,oneiric,precise}-proposed
      distribution targets to dpkg-dev-el.
    - Add precise{,-proposed} distribution targets; drop out the oneieric
      non-proposed target, since uploads to the release pocket are not
      permitted for stable releases.
    - Teach emacs-goodies-el about quantal and quantal-proposed.
    - Teach debian-changelog-mode.el about raring and raring-proposed.

 -- Logan Rosen   Mon, 19 Nov 2012 21:16:17 -0500

emacs-goodies-el (35.2+nmu1) unstable; urgency=low

  * Non-maintainer upload.
  * No longer create /root/.gnupg during installation of gnus-bonus-el.
    This is achieved by binding epg-gpg-home-directory to a temporary
    directory during bytecode compilation (implementation in
    debian/emacsen-install.template). (Closes: #689807)

 -- Sébastien Villemot   Sun, 21 Oct 2012 11:30:47 +0200

emacs-goodies-el (35.2ubuntu3) raring; urgency=low

  * Teach debian-changelog-mode.el about raring and raring-proposed.

 -- Adam Conrad   Mon, 22 Oct 2012 10:36:14 +0100

emacs-goodies-el (35.2ubuntu2) quantal; urgency=low

  * Teach emacs-goodies-el about quantal and quantal-proposed (LP: #994208)

 -- Adam Conrad   Thu, 03 May 2012 15:12:29 -0600

emacs-goodies-el (35.2ubuntu1) precise; urgency=low

  * Merge from debian unstable.  Remaining changes:
    - Add {hardy,jaunty,karmic,lucid,maverick,oneiric,precise}-proposed 
      distribution targets to dpkg-dev-el.
    - Add precise{,-proposed} distribution targets; drop out the oneieric
      non-proposed target, since uploads to the release pocket are not
      permitted for stable releases.

 -- Reinhard Tartler   Mon, 07 Nov 2011 22:47:20 +0100

emacs-goodies-el (35.2) unstable; urgency=low

  [ Roland Mas ]
  * dpkg-dev-el:
  - debian-changelog-mode.el: Allow customization of allowed distributions
    (Closes: #645303).

 -- Peter S Galbraith   Thu, 27 Oct 2011 13:30:01 -0400

emacs-goodies-el (35.1) unstable; urgency=low

  * emacs-goodies-el:
  - Bug fix: "cwebm still included in package description", thanks to era
    eriksson (Closes: #541348).
  * Bug fix: "wdired still mentioned in package description", thanks to
    Sven Joachim (Closes: #598888).
  - ff-paths.el: "Typo in ff-paths.el", thanks to Reuben Thomas (Closes:
    #609169).
  - markdown-mode.el: "New upstream version of markdown-mode.el
    available", thanks to Jason Blevins (Closes: #637709).
  - pod-mode.el: Skip byte-compilation for emacs21, thanks to Bob Proulx
    (Closes: #635667).
  * debian-el:
  - deb-view.el: "deb-view does not support xz-compressed debs", thanks to
    Sven Joachim (Closes: #637579).
  * dpkg-dev-el:
  - debian-control-mode.el: "please Add support for Multi-Arch field in
    debian-control-mode.el", thanks to Andreas Rottmann (Closes: #634162).

 -- Peter S Galbraith   Tue, 16 Aug 2011 23:21:02 -0400

emacs-goodies-el (35.0) unstable; urgency=low

  * emacs-goodies-el:
    New files:
  - eproject.el:  assign files to projects, programatically.
    Thanks to Florian Ragwitz (Closes: #585044).
  * dpkg-dev-el:
    - debian-control-mode.el: Added "XS-Python-Version" to
      debian-control-source-fields, thanks to Cedric Delfosse (Closes: #591697)

 -- Peter S Galbraith   Sat, 25 Jun 2011 15:47:16 -0400

emacs-goodies-el (34.2) unstable; urgency=low

  * emacs-goodies-el:
  - session.el updated to V2.3, thanks to Christoph Wedler.
  - graphviz-dot-mode.el updated to V0.3.6, thanks to Pander.
  - home-end.el, new upstream version. "home-end-home and home-end-end get
    confused inside keyboard macros", thanks to Dima Kogan
    (Closes: #614327).
  - maplev.texi: Updated from http://www.mapleprimes.com/files/84_maplev.zip
    and added (without patching) "@dircategory Emacs", thanks to
    Christophe Jarry (Closes: #609677).
  * debian-el:
  - apt-utils-el: Bug fix: "Apt-util.el doesn't know about
    Description-fr", thanks to Remi Vanicat (Closes: #613778).
    Patch applied without consulting Matt; Hope that's okay!

 -- Peter S Galbraith   Fri, 24 Jun 2011 12:37:31 -0400

emacs-goodies-el (34.1ubuntu2) oneiric; urgency=low

  * Add oneiric{,-proposed} distribution targets; drop out the maverick
    non-proposed target, since uploads to the release pocket are not
    permitted for stable releases.

 -- Reinhard Tartler   Sun, 01 May 2011 11:35:28 +0200

emacs-goodies-el (34.1ubuntu1) natty; urgency=low

  * Merge from debian unstable.  Remaining changes:
    - Add {hardy,jaunty,karmic,lucid,maverick}-proposed distribution targets
      to dpkg-dev-el.
    - Add natty{,-proposed} distribution targets; drop out the maverick
      non-proposed target, since uploads to the release pocket are not
      permitted for stable releases.

 -- Reinhard Tartler   Fri, 12 Nov 2010 18:45:23 +0100

emacs-goodies-el (34.1) unstable; urgency=low

  * debian/control:
    - Standards-Version: 3.9.0
  * gnus-bonus-el:
    - No longer depend on recent version of Emacs or gnus.
      Bug fix: "please allow emacs-snapshot as an alternative emacs",
      thanks to RISKO Gergely (Closes: #587321).
  * emacs-goodies-el:
    - perldoc.el: Complete for Perl core documentation.
      Thanks to Florian Ragwitz  for the bug report.
      (Closes: #589785)
    - pod-mode.el: New upstream release available 1.03. Thanks to
      Florian Ragwitz for the bug report (Closes: #589434).
    - tail.el: "tail.el restart timer on new output", thanks to Kevin Ryde
      (Closes: #584598).
  * dpkg-dev-el:
    - debian-copyright.el: Fix and simplify auto-mode-alist", thanks to
      Kevin Ryde (Closes: #587922).
    - debian-changelog.el: Simplify auto-mode-alist, thanks to Kevin Ryde
      (Closes: #587924)
    - dpkg-dev-el.el: Fix modify-coding-system-alist entry for utf-8,
      thanks to Kevin Ryde (Closes: #587921)

 -- Peter S Galbraith   Wed, 28 Jul 2010 11:50:25 -0400

emacs-goodies-el (34.0) unstable; urgency=low

  [ Peter S Galbraith ]
  * emacs-goodies-el:
    New files:
  - upstart-mode.el: major-mode to edit .upstart files.
    Thanks to Stig Sandbeck Mathisen (Closes: #586321).
  - graphviz-dot-mode.el: Mode for the dot-language used by graphviz (att).
    Thanks to Riccardo Vestrini (Closes: #428601).

  [ Matt Hodges ]
  * debian-el:
  - apt-utils-el: Bug fix: "When returning to the package list, it's not
    sorted anymore", thanks to Remi Vanicat (Closes: #568419).

 -- Peter S Galbraith   Sun, 27 Jun 2010 22:05:01 -0400

emacs-goodies-el (33.6ubuntu1) maverick; urgency=low

  * Merge from debian unstable.  Remaining changes: LP: #597284
    - Add {hardy,jaunty,karmic,lucid}-proposed distribution targets
      to dpkg-dev-el.
    - Add maverick{,-proposed} distribution targets; drop out the lucid
      non-proposed target, since uploads to the release pocket are not
      permitted for stable releases.

 -- Bhavani Shankar   Tue, 22 Jun 2010 19:03:03 +0530

emacs-goodies-el (33.6) unstable; urgency=low

  * debian-el:
  - debian-bug.el: Updated `debian-bug-pseudo-packages'.
  * emacs-goodies-el:
  - pod-mode.el: New upstream version 1.01, thanks to Florian Ragwitz
    (Closes: #585044).
  - emacs-goodies-el.texi: Improvement to info docs of
    auto-fill-inhibit.el, thanks to Kevin Ryde for the patch (Closes: #584970).

 -- Peter S Galbraith   Mon, 21 Jun 2010 19:09:33 -0400

emacs-goodies-el (33.5) unstable; urgency=low

  * debian-el:
  - debian-bug.el:
    Support "Bugs:" control field for unofficial packages".  
    Thanks to Håkon Stordahl  for the massive patch!
    (Closes: #222392).
  * dpkg-dev-el:
  - debian-changelog-mode.el
    Bug fix: "debian-changelog-date-utc-flag custom group", thanks to
    Kevin Ryde (Closes: #580818).  Fixed typo.

 -- Peter S Galbraith   Tue, 11 May 2010 21:46:40 -0400

emacs-goodies-el (33.4) unstable; urgency=low

  * emacs-goodies-el:
  - bm.el: New upstream version 1.43, thanks to Maindoor
    
  - color-theme.el:
    Bug fix: "color-theme: replace-in-string breaks other packages",
    thanks to intrigeri@boum.org; (Closes: #580213).  Applied patch from
    upstream CVS directly without a quilt patch because future upstream
    version won't need such a patch.
  * debian-el:
  - debian-bug.el:
    Bug fix: "M-x debian-bug no longer runs bug scripts, generates useless
     reports", thanks to Sven Joachim for the report (Closes: #579861).
    Bug fix: "please, include the output of /usr/shar/bug/...", thanks to
     Jiří Paleček for the request and to Håkon Stordahl 
     for the massive patch ! (Closes: #422506).
    This should also fix "bad interaction with reportbug", thanks to Johan
     Kullstam for reporting, and please reopen the bug if not fixed
     (Closes: #541729).
  * dpkg-dev-el:
  - debian-control-mode.el: Bug fix: "Breaks:" fields in control files is
     not recognized", thanks to Hilko Bengen (Closes: #580501).

 -- Peter S Galbraith   Fri, 07 May 2010 18:24:55 -0400

emacs-goodies-el (33.3) unstable; urgency=low

  * emacs-goodies-el:
    Bug fix: "color-theme doesn't initialize correctly", thanks to Daniele
    Giglio (Closes: #578619). Fixed documentation in Info.
  * debian-el:
  - debian-bug.el: Bug fix: "stty fails with 'inappropriate ioctl for
    device'", thanks to Sanjoy Mahajan for the report and to H. Stordahl
    for the solution that has added to reportbug: As of version 4.12
    reportbug has a --no-bug-script option (Closes: #502317).

 -- Peter S Galbraith   Wed, 28 Apr 2010 17:44:35 -0400

emacs-goodies-el (33.2) unstable; urgency=low

  * emacs-goodies-el:
  - pp-c-l.eL: Skip installing for XEmacs, thanks to Kevin Ryde
    (Closes: #577596).
  * dpkg-dev-el:
  - debian-changelog-mode.el: Invoke `debian-bug-build-bug-menu' with
    SOURCE arg set to t.  Needs debian-el 33.2
  * debian-el:
  - debian-bug.el: `debian-bug-build-bug-menu' now takes optional SOURCE
    argument. Fixes "Empty bug list", thanks to Remi Vanicat (Closes: #579394).

 -- Peter S Galbraith   Tue, 27 Apr 2010 23:39:40 -0400

emacs-goodies-el (33.1) unstable; urgency=low

  * emacs-goodies-el:
    V33.0 got away without the _actual_ dirvals.el to dir-locals.el
    transition actually done because of a CVS mistake.

 -- Peter S Galbraith   Fri, 09 Apr 2010 22:07:16 -0400

emacs-goodies-el (33.0) unstable; urgency=low

  * emacs-goodies-el:
    New files:
   - pp-c-l.el --- Display Control-l characters in a pretty way.
     Thanks to Andrey Paramonov for the suggestion (Closes: #524081).
   - dir-locals.el -- Local variables for a directory tree
    Removed file:
   - dirvals.el, replaced with dir-locals.el. Thanks to Dave Love
     (Closes: #377676).
    New upstream version:
   - egocentric.el.  Patch from Ubuntun bug #109132 applied for
     customization mismatches.
   - xrdb-mode.el V3.0.  Bug fix: "xrdb-mode docstring show keymap",
     thanks to Kevin Ryde (Closes: #559514).  Apologies to Barry Warsaw
     since this version was ready last December.

 -- Peter S Galbraith   Fri, 09 Apr 2010 21:33:48 -0400

emacs-goodies-el (32.0) unstable; urgency=low

  * emacs-goodies-el:
    New files:
   - miniedit.el --- Enhanced editing for minibuffer fields.
     Thanks to Joerg Jaspert for the suggestion (Closes: #514519).
   - bm.el --- Visible bookmarks in buffers.
     Thanks to Boris Daix for the suggestion (Closes: #353982).
    Bug fixes:
   - ctypes.el: Added a require for cc-mode in order to use its font-lock
     faces.  Should close Unbuntu bug #162954.
   - color-theme_seldefcustom.el: New file to hold `color-theme' selection
     customization to avoid loading color-theme on startup even for those
     who don't use it.

 -- Peter S Galbraith   Wed, 07 Apr 2010 14:14:23 -0400

emacs-goodies-el (31.8) unstable; urgency=low

  * emacs-goodies-el:
  - map-lines.el: New upstream version by new maintainer Paul Hobbs.
  - perldoc.el: New upstream version by Ben Voui, fixes "perldoc.el in
    buffer with non-existent current directory", thanks to Kevin Ryde
    (Closes: #574650).
  - color-theme: "Please update to color-theme 6.6", thanks to Douglas Calvert
    (Closes: #573059).  Now comes in two files: color-theme.el and
    color-theme-library.el, which was added to the package.  Upstream uses
    a subdirectory for it, but I opted not-to for simplicity.  I did have
    to patch it a bit to look for "color-theme-*" files instead of
    "color-theme*" files for that reason.

 -- Peter S Galbraith   Tue, 06 Apr 2010 16:59:33 -0400

emacs-goodies-el (31.7) unstable; urgency=low

  * Migrate source patching from dpatch to quilt.
  * Migrate to source package format "3.0 (native)".
  * emacs-goodies-el:
  - cyclebuffer.el: removed since users can now do that using "C-x C-left"
    and "C-x C-right", thanks to jidanni@jidanni.org (Closes: #476497).
  - maplines.el: New upstream version by new maintainer Paul Hobbs.

 -- Peter S Galbraith   Mon, 05 Apr 2010 16:01:56 -0400

emacs-goodies-el (31.6) unstable; urgency=low

  [ Peter S Galbraith ]
  * emacs-goodies-el: The following files were removed because they are
    included in Emacs-23:
     cua.el
     cfengine.el
     ibuffer.el
     ido.el 
     newsticker.el 
     nuke-trailing-whitespace.el
     table.el
     wdired.el
  - perldoc.el: New upstream version by Ben Voui, fixes "perldoc.el
    incomplete module cache if interrupted" reported by Kevin Ryde
    (Closes: #575455).

  [ Junichi Uekawa ]
  * dpkg-dev-el:
  - readme-debian.el: Bug fix: "README.Debian date wrong in XEmacs",
    thanks to Russ Allbery (Closes: #364234).

 -- Peter S Galbraith   Thu, 01 Apr 2010 15:58:42 -0400

emacs-goodies-el (31.5) unstable; urgency=low

  * emacs-goodies-el:
  - lcomp.el: New upstream version (Closes: #551827).
  - emacs-goodies-el.el :Replace $ by \\' in auto-mode-alist entries,
    thanks to Kevin Ryde (Closes: #570293).
  * dpkg-dev-el:
  - debian-bts-control.el: Bug fix: "emacs-bts-control command should be
    autoloaded", thanks to Sven Joachim (Closes: #565934).

 -- Peter S Galbraith   Mon, 22 Feb 2010 20:53:01 -0500

emacs-goodies-el (31.4ubuntu1) lucid; urgency=low

  * Merge from debian testing.  Remaining changes:
    - Add {hardy,intrepid,jaunty,karmic}-proposed distribution targets
      to dpkg-dev-el.
    - Add lucid{,-proposed} distribution targets; drop out the karmic
      non-proposed target, since uploads to the release pocket are not
      permitted for stable releases.

 -- Bhavani Shankar   Tue, 19 Jan 2010 11:13:40 +0530

emacs-goodies-el (31.4) unstable; urgency=low

  * emacs-goodies-el:
  - Bug fix: "xemacs21 empty emacs-goodies-loaddefs.el", thanks to Kevin
    Ryde (Closes: #563853).

 -- Peter S Galbraith   Wed, 06 Jan 2010 22:17:10 -0500

emacs-goodies-el (31.3) unstable; urgency=low

  * emacs-goodies-el:
  - maplev.texi: "the maplev info file contain incorect
    START-INFO-DIR-ENTRY entry", thanks to R. Vanicat (Closes: #559557).
    I had two fixes; one on matlev.texi in CVS and one as a dpatch.
  * debian-el:
  - debian-bug.el: Emacs BTS moved to debbugs.gnu.org 
  * dpkg-dev-el:
  - debian-bts-control.el: Emacs BTS moved to debbugs.gnu.org
    Thanks to Sven Joachim (Closes: #561561).
  * Debian native version number: Package tar ball now includes debian
    directory, previously distributed in the diff.gz file.  This allows
    the copyright and patches to be distributed together as the package is
    now repackaged and distributed by fedora.

 -- Peter S Galbraith   Sat, 19 Dec 2009 09:22:00 -0500

emacs-goodies-el (31.2-1) unstable; urgency=low

  * debian-el:
  - apt-sources.el: Create syntax table and add comments.
    Thanks to Trent W. Buck for the report (Closes: #469971).
  * emacs-goodies-el:
  - emacs-goodies-el.texi: specify @documentencoding ISO-8859-1  
  - cua.el: don't install for emacs22, emacs23 and emacs-snapshot
  - matlab.el caused Objective-C files to be visited in matlab-mode,
    thanks to Yavor Doganov for the report (Closes: #557932).  Created
    `matlab-auto-mode' customization variable.

 -- Peter S Galbraith   Wed, 02 Dec 2009 22:47:21 -0500

emacs-goodies-el (31.1-1) unstable; urgency=low

  * dpkg-dev-el:
  - debian-bts-control.el:
   - Bug fix: "Symbol's function definition is void: conact",
     thanks to Sven Joachim (Closes: #557408).
   - Bug fix: "CC's debian-bts-emailaddress, literally",
     thanks to Sven Joachim (Closes: #557412).

 -- Peter S Galbraith   Sun, 22 Nov 2009 10:54:31 -0500

emacs-goodies-el (31.0-1) unstable; urgency=low

  * vm-bonus-el
  - package re-activated.
  - vm-bogofilter.el: New file. Thanks to Patrice Karatchentzeff
    (Closes: #353827).
  * dpkg-dev-el:
  - debian-changelog-mode.el: Updated URL for "Best practices".

 -- Peter S Galbraith   Sat, 14 Nov 2009 17:18:49 -0500

emacs-goodies-el (30.11-1) unstable; urgency=low

  * Added debian/README.source
  * Fixed rules file to use binary-indep target.
  * Various lintian fixes.
  * Added COPYING-GPL-v2 COPYING-GPL-v3 to tar ball as requested by
    Fedora, who now distribute emacs-goodies-el.
  * debian-el:
  - debian-bug.el: Add `emacs-bug-web-bug', `emacs-bug-get-bug-as-email':
    new commands to interface with Emacs BTS
  * dpkg-dev-el:
  - debian-bts-control.el: Add command `emacs-bts-control': new command to
    interface with Emacs BTS.

 -- Peter S Galbraith   Thu, 12 Nov 2009 16:27:41 -0500

emacs-goodies-el (30.10-1) unstable; urgency=low

  * debian-el:
  - deb-view.el: "deb-view.el fails on own debian-el_30.9-1_all.deb",
    thanks to Kevin Ryde (Closes: #554039).
  * vm-bonus-el
    Add a copyright file.

 -- Peter S Galbraith   Tue, 03 Nov 2009 17:00:50 -0500

emacs-goodies-el (30.9-1) unstable; urgency=low

  * emacs-goodies-el:
  - Bug fix: "'M-x customize-group markdown' doesn't load
    markdown-mode.el", thanks to Kevin Ryde (Closes: #551014).  Edited
    emacs-goodies-custom.el as suggested by Kevin.
  * dpkg-dev-el:
  - debian-changelog-mode.el: debian-changelog-close-bug does not work
    properly under XEmacs 21.4.21 because the arguments passed to
    replace-in-string in the inline function debian-chagelog--rris are in
    the wrong order (Closes: #476271).  (I apologise for losing track of
    this bug for so long).
  * debian-el:
  - deb-view.el: Added support for data.tar.bz2 deb files (Closes: #457094).
  - Changed dependency on binutils for bzip2, file and gzip.
  
 -- Peter S Galbraith   Sun, 25 Oct 2009 12:11:31 -0400

emacs-goodies-el (30.8-1ubuntu1) lucid; urgency=low

  * Merge from Debian testing, remaining changes:
    - Add {hardy,intrepid,jaunty,karmic}-proposed distribution targets
      to dpkg-dev-el.
  * Add lucid{,-proposed} distribution targets; drop out the karmic
    non-proposed target, since uploads to the release pocket are not
    permitted for stable releases.

 -- Steve Langasek   Mon, 09 Nov 2009 12:39:17 +0000

emacs-goodies-el (30.8-1) unstable; urgency=low

  * debian-el
  - Bug fix: "never cleaned up 50debian-el.el", thanks to
    jidanni@jidanni.org; (Closes: #487175).  Created debian-el.postinst to
    delete the old file if found.
  - Bug fix: "Outputs wrongly utf-8 chars if the buffer is called
    control", thanks to Marco Túlio Gontijo e Silva (Closes: #526374).
    Edited deb-view-control-coding to (1) return 'undecided instead or nil
    when there's no match, and (2) call deb-view-control-coding only on
    exact match of "control" filename.
  * Added "${misc:Depends}" Depends as per policy to all binary packages.
  * Added "dpkg (>= 1.15.4) | install-info" Depends as per policy to
    emacs-goodies-el and debian-el as they install info file.

 -- Peter S Galbraith   Sun, 11 Oct 2009 16:17:40 -0400

emacs-goodies-el (30.7-2) unstable; urgency=low

  * emacs-goodies-el:
  - Bug fix: "dpkg install error on 30.7-1", thanks to Kevin Ryde
    (Closes: #550421).  New emacs-goodies-loaddefs.el scheme failed with
    emacs21 because it doesn't except an empty file.

 -- Peter S Galbraith   Sat, 10 Oct 2009 13:03:47 -0400

emacs-goodies-el (30.7-1) unstable; urgency=low

  * emacs-goodies-el:
  - Bug fix: "dpkg: error processing emacs-goodies-el (--configure):",
    thanks to John A Martin (Closes: #550225). The autoloads file
    emacs-goodies-loaddefs.el used to be pre-generated using the latest
    Emacs flavour, and XEmacs found code that it didn't understand.  My
    fix is to build it at install time for each installed Emacs flavour.

 -- Peter S Galbraith   Thu, 08 Oct 2009 17:35:30 -0400

emacs-goodies-el (30.6-1) unstable; urgency=low

  * emacs-goodies-el:
   - dirvars.el: Updated to 1.3 (by Benjamin Rutt)
   - folding.el: Updated to 2009.0220.1404
   - highlight-completion.el: Updated to 0.08
   - ibuffer.el: Updated to 2.6.1
   - maplev.el : Updated to 2.155
   - matlab.el: Updated to 3.3.0
   - nuke-trailing-whitespace.el: Updated to CVS 1.11
   - rfc-view.el: Updated to 0.12
   - shell-command.el: Updated to CVS 1.38
   - show-wspace.el: Updated to 282
   - silly-mail.el updated.
   - wdired.el: Updated to1.9.2pre3
   - home-end.el updated.
   - markdown-mode.el: Updated to 1.7, thanks to Jason Blevins
     (Closes: #549208).
   - Fix typos in control file, thanks to Reuben Thomas
     (Closes: #549917, #549918).
   - Improved summary of session.el for package description, thanks to
     Reuben Thomas (Closes: #549924).
   - Move nuke-trailing-whitespace to superseded category, thanks to
     Reuben Thomas (Closes: #549923)

 -- Peter S Galbraith   Wed, 07 Oct 2009 17:17:59 -0400

emacs-goodies-el (30.5-1) unstable; urgency=low

  * emacs-goodies-el:
   - perldoc.el: Updated to 1.7
   - htmlize.el: Updated to lastest upstream version.  Bug fix:
     "htmlize-region complains about Invalid face", thanks to Eric
      Warmenhoven (Closes: #544593).
   - align-string.el: Updated to lastest upstream version.
   - apache-mode.el: Updated to lastest upstream version.
   - ascii.el: Updated to 2.2.1
   - boxquote.el: Updated to 1.23
   - browse-kill-ring.el: Updated to (unofficial?) 1.3a, which includes 
     50_browse-kill-ring_bug225082.dpatch, now removed.  
     However 50_browse-kill-ring_bug224751.dpatch was not applied upstream,
     so is still included in Debian.
  
 -- Peter S Galbraith   Thu, 03 Sep 2009 10:39:10 -0400

emacs-goodies-el (30.4-1) unstable; urgency=low

  * debian-el:
   - deb-view.el: Bug fix: "undo limit vs. .deb", thanks to Dan Jacobson
     for reporting and to Sven Joachim for the patch.  Apologies for
     forgetting about it for so long (Closes: #388637).
   - debian.el: Bug fix: "deb-view-control-coding assumes buffer-file-name
     is non-nil", thanks to Sven Joachim for the report and the patch.
     Again, apologies ! (Closes: #523469).
  * emacs-goodies-el:
   - perldoc.el: Fixed "allow uniquely-named buffers" and "add completion
     for modules", thanks to new "upstream" intrigeri@boum.org;
     (Closes: #504186, #504230).
  * debian/control: Bug fix: "Incorrect Vcs-Browser URL", thanks to
     jamessan@debian.org; (Closes: #528295).
     Bug fix: "gnus-bonus-el needs to allow emacs23 in dependency", thanks
     to Russ Allbery (Closes: #541361).

 -- Peter S Galbraith   Wed, 02 Sep 2009 17:05:19 -0400

emacs-goodies-el (30.3-1ubuntu1) karmic; urgency=low

  * Resynchronise with Debian. Remaining changes: LP: #400965
    - Add {hardy,intrepid,jaunty}{,-proposed} distribution targets to
      dpkg-dev-el.
    - Add karmic{,-proposed} distribution targets; drop out the jaunty
      non-proposed target, since uploads to the release pocket are not
      permitted for stable releases.

 -- Bhavani Shankar   Sat, 15 Aug 2009 11:29:09 +0530

emacs-goodies-el (30.3-1) unstable; urgency=low

  [ Daniel Moerner ]
  * Change references in all *-loaddefs.make files to call emacs rather
    than emacs21 as emacs21 is scheduled for removal from unstable.

  [ Peter S Galbraith ]
  * Update for emacs23
    - Bug fix: "emacs-goodies-el's ido takes precedence over emacs23's",
      thanks to Trent W. Buck (Closes: #539853).
    - Bug fix: "please update for emacs23", thanks to Sven Joachim
      (Closes: #539768).

 -- Peter S Galbraith   Tue, 04 Aug 2009 10:15:33 -0400

emacs-goodies-el (30.2-1) unstable; urgency=low

  * emacs-goodies-el:
    - quack.el: Bug fix: "quack overrides emacs defaults, should probably
      be optional (aggressive)", thanks to Sami Liedes (Closes: #536154).

 -- Peter S Galbraith   Fri, 17 Jul 2009 17:02:14 -0400

emacs-goodies-el (30.1-1) unstable; urgency=low

  [ Daniel Moerner ]
  * emacs-goodies-el:
    - quack.el: updated to version 0.37, autoload patch
      refreshed. (Closes: #530703)  
  * Bug fix: Remove useless co from Vcs-Cvs field. (Closes: #530702)
  
  [ Peter S Galbraith ]
  * emacs-goodies-el:
    - "please add info-dir-section to your info files", thanks to
      Norbert Preining (Closes: #528868).
    - muttrc-mode.el: Files updated by Kumar Appaiah (Closes: #451477).

 -- Peter S Galbraith   Thu, 09 Jul 2009 15:30:33 -0400

emacs-goodies-el (30.0-1) unstable; urgency=low

  * emacs-goodies-el:
    - pod-mode.el: updated to V0.502, thanks to Kevin Ryde
      (Closes: #499473).
    - emacs-goodies-loaddefs.el: rebuilt to remove cwebm.el autoloads
      (Bug #541348 fixed here but existed since 28.0-1).
    New file:
    - quack.el: Added file (version 0.34), integration contributed by
      Daniel Moerner , (Closes: #509486)
  * debian-el:
    - debian-bug.el: "List of pseudo-packages not up to date".
      Thanks to Tommi Vainikainen (Closes: #526496).
    - debian-bug.el: "[PATCH] using the "maintainer mbox" instead of "mbox
      folder". Thanks to Evgeny M. Zubok (Closes: #521571).
    - debian-bug.el: "incomplete Bugs menu again", thanks to A Mennucc
      (Closes: #524043).

 -- Peter S Galbraith   Thu, 14 May 2009 21:36:06 -0400

emacs-goodies-el (29.5-1ubuntu1) karmic; urgency=low

  * Resynchronise with Debian. Remaining changes:
    - Add {hardy,intrepid,jaunty}{,-proposed} distribution targets to
      dpkg-dev-el.
  * Add karmic{,-proposed} distribution targets; drop out the jaunty
    non-proposed target, since uploads to the release pocket are not
    permitted for stable releases.

 -- Colin Watson   Mon, 27 Apr 2009 20:52:17 +0100

emacs-goodies-el (29.5-1) unstable; urgency=low

  * debian-el:
    - debian-bug.el:
      Bug fix: Adapted patch from Håkon Stordahl to quote bug descriptions
      when building the bug menu. (Closes: #489786).
      Bug fix: Applied patch from Håkon Stordahl 
      for garbled Help buffer (Closes: #502426).      
    - apt-utils.el:
      Fix help text error, thanks to Jens Thiele (Closes: #459958)
    - debian-el.el:
      Add code from Kevin Ryde to set deb-view control file coding system
      (Closes: #484027)
  * dpkg-dev-el:
    - dpkg-dev-el.el:
      Moved some stuff in from 50dpkg-dev-el.el.
      Added README.Source to auto-mode-alist, thanks to Noah Slater
      (Closes: #490292).
    - debian-control-mode.el
      Applied patch from Morten Kjeldgaard changing Dm-Upload-Allowed to
      DM-Upload-Allowed (Closes: #508748).
    - debian-bts-control.el
      Applied patch from Luca Capello  adding
      `debian-bts-control-cc-or-bcc' (Closes: #392494)
    - debian-changelog-mode.el
      Added patch from Jari Aalto to finalize date in UTC (User
      configurable) (Closes: #503700)
  * vm-bonus-el
    - This is now a dummy package since u-vm-color.el is now bundled and
      maintained with VM.  Thanks to Sven Joachim (Closes: #510945).

 -- Peter S Galbraith   Mon, 23 Feb 2009 20:11:51 +0000

emacs-goodies-el (29.4-1ubuntu2) jaunty; urgency=low

  * Capitalization of tag Dm-Upload-Allowed in debian/control
    changed to the more commonly used DM-Upload-Allowed (LP: #307920)
    Fixed by 99_ubuntu_dm_upload_fix.dpatch.
  * Ubuntu maintainer mangling

 -- Morten Kjeldgaard   Mon, 23 Feb 2008 15:10:00 +0100

emacs-goodies-el (29.4-1ubuntu1) jaunty; urgency=low

  * Merge from Debian unstable, remaining changes:
    - add {hardy,intrepid}{,-proposed} distribution targets to dpkg-dev-el.
  * add jaunty{,-proposed} distribution targets; drop out the hardy and
    intrepid non-proposed targets, since uploads to the release pocket
    are not permitted for stable releases.

 -- Steve Langasek   Fri, 14 Nov 2008 00:23:50 +0000

emacs-goodies-el (29.4-1) unstable; urgency=high

  * debian-el:
    - debian-bug.el:
      Bug fix: "Bug submenus have vanished", thanks to Bill Wohler for the
      report and to Camm Maguire for an initial patch (Closes: #463053).
      This _should_ go in lenny; I have only changed code that was currently
      broken under the new Debian bug web page format.
  * emacs-goodies-el:
    - markdown-mode.el: Thanks to Jason Blevins for the new upstream version
      1.6. It fixes "blockquote-region only works if the region was selected
      with the mouse" submitted by Daniel Burrows (Closes: #456592).

 -- Peter S Galbraith   Tue, 09 Sep 2008 21:28:31 -0400

emacs-goodies-el (29.3-2ubuntu1) intrepid; urgency=low

  * add {hardy,intrepid}{,-proposed} distribution targets to dpkg-dev-el.
    LP: #267822

 -- Reinhard Tartler   Mon, 08 Sep 2008 18:21:15 +0200

emacs-goodies-el (29.3-2) unstable; urgency=low

  * devscripts-el:
  - Bug fix: "devscripts-el: missing dependency on apel (mcharset.el)".
    Thanks to Luca Capello (Closes: #483244).

 -- Peter S Galbraith   Wed, 28 May 2008 19:46:13 -0400

emacs-goodies-el (29.3-1) unstable; urgency=low

  * devscripts-el:
   - Bug fix: "devscripts-el: Downgrade elserv dependency to Recommends".
     Thanks to Tim Retout (Closes: #475791).

 -- Peter S Galbraith   Mon, 26 May 2008 20:17:18 -0400

emacs-goodies-el (29.2-1) unstable; urgency=low

  * emacs-goodies-el:
    - Updated to lastest version compatible with GPL V3:
        box-quote.el
        mutt-alias.el
        obfusurl.el
        protocols.el
        services.el
        thinks.el
        tld.el
    - rfcview.el: Updated from maintained version at
      http://www.loveshack.ukfsn.org/emacs/rfcview.el
      Should fix fontification bug reported by jidanni@jidanni.org
      but no longer works with XEmacs (it requires view.el).
      (Closes: #464940).
    - Fix S-Lang spelling in package description.
      Thanks to Rafael Laboissiere (Closes: #460445).
  * debian-el:
    - Enable apt-sources-mode for files in /etc/apt/sources.list.d/".
      Thanks to Géraud Meyer for the report and patch (Closes: #475701).
  * dpkg-dev-el:
    - Generalise automatic invocation to files named debian/package.changelog
      Thanks to Trent W. Buck for the report and patch.  (Closes: #457047)

 -- Peter S Galbraith   Sat, 12 Apr 2008 09:49:26 -0400

emacs-goodies-el (29.1-1) unstable; urgency=low

  [ Sven Joachim ]
  * vm-bonus-el:
    - Don't include vm-rfaddons.el and depend on vm versions
      that ship that file (Closes: #469652, #469625). 

  [ Cyril Brulebois ]
  * dpkg-dev-el:
    - debian-control-mode.el: Added `Dm-Upload-Allowed' to the list of
      valid fields for the source packages.
  
  [ Peter S Galbraith ]
  * Bug fix: "emacs-goodies-el: FTBFS if built twice in a row", thanks to
    Sven Joachim (Closes: #469751).

 -- Peter S Galbraith   Wed, 26 Mar 2008 20:26:56 -0400

emacs-goodies-el (29.0-1) unstable; urgency=low

  [ Cyril Brulebois ]
  * debian/changelog:
    - Converted to UTF-8.  Thanks to Bas Zoetekouw.
     (Closes: #453964, #453973, #453974, #453978, #454008, #454034).
    - Deleted local variables at the end, Emacs shouldn't need this any
      longer.
    - Nuked trailing spaces at the same time.
  * emacs-goodies-el:
    - pod-mode.el: Added file (version 0.4), as suggested by
      Emmanuel Bouthenot (Closes: #452857).
  * debian/control:
    - Added Vcs-Cvs and Vcs-Browser fields.

  [ Peter S Galbraith ]
  * emacs-goodies-el:
    - minibuffer-complete-cycle.el: Updated to V1.14 with patch from
      Sebastian P. Luque.

 -- Peter S Galbraith   Tue, 04 Dec 2007 19:41:04 -0500

emacs-goodies-el (28.3-1) unstable; urgency=low

  [ Peter S Galbraith ]
  * emacs-goodies-el:
    - htmlize.el: Updated file to V1.34 (Thanks to S.P. Tseng).
    - todoo.el: Symbol's function definition is void:
      outline-font-lock-level", I had forgotten an instance of that old
      function. Thanks to Jens Thiele and Sven Joachim (Closes: #447760).
  * debian-el:
    - apt-utils.el: "suggest apt-utils-show-package defer package name
      completions", thanks to Kevin Ryde and Matt Hodges (Closes: #442425).

  [ Cyril Brulebois ]
  * emacs-goodies-el:
    - markdown-mode.el: Updated file to V1.5.
  * dpkg-dev-el:
    - debian-control-mode.el: Renamed `XS-Vcs-*' into `Vcs-*' since these
      fields are now recognized by dpkg (since 1.14.7).

 -- Peter S Galbraith   Tue, 23 Oct 2007 20:31:24 -0400

emacs-goodies-el (28.2-1) unstable; urgency=low

  [ Cyril Brulebois ]
  * emacs-goodies-el:
    Updated file:
    - show-wspace.el: upstream has added a `show-ws-' prefix to improve
      semantics and avoid namespace clash.
  * dpkg-dev-el:
    Updated file:
    - debian-control-mode.el: added `Homepage' to the list of the valid fields
      for the source packages.
    - debian-control-mode.el: added `XS-Vcs-Browser' and `XS-Vcs-*' to the
      list of the valid fields for the source packages. The list of valid *
      has been taken from:
        http://svn.debian.org/wsvn/qa/trunk/pts/www/bin/common.py?op=file
      Patch contributed by Rafael Laboissiere (Closes: #422491).

 -- Peter S Galbraith   Wed, 03 Oct 2007 19:36:13 -0400

emacs-goodies-el (28.1-1) unstable; urgency=low

  * emacs-goodies-el:
    - xrdm-mode.el: Added pointer to `xrdb-mode-setup-auto-mode-alist'
      customization to enable this feature in both Info file and
      README.Debian. .  Thanks to Reuben Thomas (Closes: #411434).

 -- Peter S Galbraith   Mon, 24 Sep 2007 20:54:42 -0400

emacs-goodies-el (28.0-1) unstable; urgency=low

  [ Cyril Brulebois ]
  * debian/control:
    - Removed Roland Mas from the Uploaders upon his request.
  * emacs-goodies-el:
    New file:
    - show-wspace.el: highlights whitespaces of various kinds.
      Thanks to Lennart Poettering for the suggestion (Closes: #422876).

  [ Peter S Galbraith ]
  * debian-el:
    - gnus.BTS.el: Implement "reading bugs as mail instead of in browser".
      Thanks to Johannes Rohr for the report and to intrigeri for the patch
      (Closes: #218286).
    - debian-bug.el: Add `debian-bug-get-bug-as-email-hook' and relative
      `run-hooks' patch from Luca Capello (Closes: #392475)
  * emacs-goodies-el:
    - cwebm.el: Blank out the contents of cwebm.el, whose license is not
      compatible with Emacs.
    - rfcview.el: Add hyperlinks for rfcview.el patch from Dave Love
      (Closes: #377678).

 -- Peter S Galbraith   Mon, 24 Sep 2007 20:36:30 -0400

emacs-goodies-el (27.7-1) unstable; urgency=low

  * debian-el:
    - gnus-BTS.el: fails when clicking a bug. Thanks to Jhair Tocancipa
      Triana and Manoj Srivastava for reports, and to Elias Oltmanns for
      testing my fix. (Closes: #363161, #442438).
  * gnus-bonus-el:
    - gnus-pers.el: gives newsgroup setting priority over interactive
      choice". Thanks to Bruce Stephens and to Elias Oltmanns
      (Closes: #263371).

 -- Peter S Galbraith   Tue, 18 Sep 2007 21:38:17 -0400

emacs-goodies-el (27.6-1) unstable; urgency=low

  * gnus-bonus-el:
    - gnus-pers.el: "Cc-fix feature in gnus-pers is horribly broken".
      Thanks to Elias Oltmanns for the report and the patches, and I
      apologise for the delay in applying them! (Closes: #384209).

 -- Peter S Galbraith   Mon, 17 Sep 2007 22:15:29 -0400

emacs-goodies-el (27.5-1) unstable; urgency=low

  * debian-el: debian-bug.el (and debian-changelog-mode.el)
    - Implement pacakge lookup on http://packages.debian.org/
      See http://bugs.debian.org/87725
  * dpkg-dev-el:
    - Patch from Luca Capello  to add keys to generate the
      open bug alist (Closes: #430517).

 -- Peter S Galbraith   Sun, 02 Sep 2007 21:39:14 -0400

emacs-goodies-el (27.4-1) unstable; urgency=low

  * dpkg-dev-el:
    - debian-bts-control.el: Added `fixed' `notfixed' `block' `unblock'
      `archive' `unarchive' `found' `notfound'.  Thanks to intrigeri
      (Closes: #391647).

 -- Peter S Galbraith   Thu, 30 Aug 2007 09:27:43 -0400

emacs-goodies-el (27.3-1) unstable; urgency=low

  * dpkg-dev-el:
    - debian-bts-control.el: debian-bts-control suffers of bug #336466 and
      doesn't skip over mml directives.
      Thanks to Luca Capello (Closes: #392132).

 -- Peter S Galbraith   Thu, 30 Aug 2007 08:25:26 -0400

emacs-goodies-el (27.2-1) unstable; urgency=low

  * debian-el:
    - debian-bug.el: "Bugs menu gone due to missing
      debian-changelog-close-bug-statement", thanks to Bill Wohler
      (Closes: #440002).
  * emacs-goodies-el:
    - Bug fix: Lists packages available in emacs22 separately.
      Thanks to Trent W. Buck (Closes: #438498).
    - Bug fix: "Description field typo, s/: / - /."
      Thanks to Trent W. Buck (Closes: #438497).
    - cfengine.el: Updated to better version of cfengine.el.
      Thanks to its author, Dave Love (Closes: #377675).
    - todoo-mode.el: Symbol function definition is void:
      outline-font-lock-level in todoo-indent-line".
      Thanks to Kumar Appaiah (Closes: #438964).

 -- Peter S Galbraith   Wed, 29 Aug 2007 22:01:32 -0400

emacs-goodies-el (27.1-1) unstable; urgency=low

  * emacs-goodies-el: postinst failed with emacs22 because silly-mail
    required sendmail.el and failed to byte-compile if /usr/bin/mail
    didn't exist. Thanks to Josh Triplett (Closes: #434104).

 -- Peter S Galbraith   Wed, 08 Aug 2007 19:42:02 -0400

emacs-goodies-el (27.0-1) unstable; urgency=low

  [ Cyril Brulebois ]
  * emacs-goodies-el:
    New file:
    - markdown-mode.el: major mode for editing Markdown files
      (Closes: #435485).

  [ Peter S Galbraith ]
  * debian/compat thanks to Michael Olson.
  * debian-el:
    - /etc/emacs/site-start.d/51debian-el.el: Typo: debian-el-el,
      thanks to Josh Triplett (Closes: #427770).
  * dpkg-dev-el:
    - debian-bts-control.el: Use `C-c C-b' instead of `C-c c' (Closes: #435247).
    - debian-changelog-model.el:
      auto-mode-alist  for "/debian/*NEWS" files, thanks to Per Olofsson
      (Closes: #424779).
  * emacs-goodies-el:
    - tabbar.el updated to version 2.0 and Info updated as well.
      Thanks to Michal Sojka (Closes: #435335).

 -- Peter S Galbraith   Wed, 08 Aug 2007 18:47:33 -0400

emacs-goodies-el (26.13-1) unstable; urgency=low

  * Bug fix: "gnus-bonus-el does not know about emacs22", thanks to
    Mikhail Gusarov (Closes: #434491).
  * Bug fix: "emacs-goodies-el: Please prefer emacs22 as first
    alternative", thanks to Sven Joachim (Closes: #432100).
  * Bug fix: "[debian-bug.el, debian-changelog-mode.el] please be
    consistent for the close statement", thanks to Luca Capello (Closes:
    #431091).
  * Bug fix: "cyclebuffer.el too old global-set-key example", thanks to
    Dan Jacobson (Closes: #371861).
  * Bug fix: "emacs-goodies-el: df-mode break minor-mode-alist and
    function using it".  Added 50_df_minor_mode_alist.dpatch thanks to
    Remi Vanicat (Closes: #430788).

 -- Peter S Galbraith   Wed, 25 Jul 2007 21:53:16 -0400

emacs-goodies-el (26.12-1) unstable; urgency=low

  [ Michael Olson ]
  * debian/emacs-goodies-el.emacsen-install.in:
    - (EXCLUDED_emacs22): Exclude programs that are part of Emacs 22.
  * debian/compat:
    - Set to 4 to silence lintian warning.
  * debian/control:
    - (Standards-Version): Set to 3.7.2
    - (Build-Depends): Move debhelper and dpatch here.
  * debian/rules:
    - Don't set DH_COMPAT.
  [ Junichi Uekawa ]
  * devscripts-el:
   - unset read-only state in debuild.
  * pbuilder-mode.el:
   - unset read-only state.
  [ Peter Galbraith ]
  * gnus-bonus-el.emacsen-install.in, debian-el.emacsen-install.in: Setup
    emacs22 with similar exceptions as emacs-snapshot.

 -- Peter S Galbraith   Fri, 20 Jul 2007 10:14:25 -0400

emacs-goodies-el (26.11-1) unstable; urgency=low

  * dpkg-dev-el:
   - debian-changelog-mode.el: Use "date -R" instead of deprecated
    "822-date".  Thanks to Matej Vela. (Closes: #423142, #423155, #423828)
  * emacs-goodies-el:
   - todoo.el: Comment out clobbering of outline-mode-menu-bar-map key
     entries. This is far too aggressive.  A much better fix would be to
     undefine the keys for todoo-mode-map.  Thanks to Simon Pepping
     (Closes: #414781).
   - filladapt.el: Make turn-on-filladapt-mode interactive.
     Thanks to Kevin Ryde (Closes: #420845).

 -- Peter S Galbraith   Mon, 14 May 2007 19:26:43 -0400

emacs-goodies-el (26.10-1) unstable; urgency=low

  [ Junichi Uekawa ]
  * dpkg-dev-el:
    - debian-changelog-mode.el: support co-maintainers. If previous
      maintainer editing the entry is different from the current, an
      entry of the form '[ NAME ]' is created.
      Thanks to Luca Capello (Closes: #352957).
  * debian-el:
    - fix debian-bug.el (debian-bug-build-bug-menu) to work with new
      BTS output format.
  [ Peter S Galbraith ]
  * gnus-bonus-el:
    - gnus-pers.el: gnus-functionp is absent in Oort Gnus, thanks
      to Dmitry Astapov (Closes: #416360).
  * emacs-goodies-el:
   - emacs-goodies-el.el: xrdb-mode clobbers bindings in emacs-snapshot,
     thanks to R.Ramkumar (Closes: #402580).
   - emacs-goodies-el.el: Too many files put into cfengine-mode,
     thanks to Sven Joachim (Closes: #408285).
   - emacs-goodies-el.el: "add apache2.conf to auto-mode-alist",
     thanks to Shannon Eric Peevey (Closes: #392719).
  * dpkg-dev-el:
   - 50dpkg-dev-el.el: "Fixed native package changelog coding system for
     emacs 22", thanks to Kevin Ryde (Closes: #416218).
   - debian-bts-control.el: typo in debian-bts-control-modes-to-reuse,
     thanks to Luca Capello (Closes: #392274).
  * debian-el:
   - debian-bug.el: Updated list of pseudo packages,
     thanks to Sven Joachim (Closes: #417882).

 -- Peter S Galbraith   Mon, 14 May 2007 19:24:37 -0400

emacs-goodies-el (26.9-1) unstable; urgency=low

  * debian-el:
    - debian-bug.el: Added "Owner:" to ITP bugs. Thanks to Romain
      Francoise for bringing this to my attention (Closes: #388747).
  * dpkg-dev-el:
    - debian-bts-control.el: Some tags are missing in the list". I also
      updated debian-bug.el. Thanks to Thomas Weber (Closes: #373283).

 -- Peter S Galbraith   Fri, 22 Sep 2006 15:29:06 -0400

emacs-goodies-el (26.8-1) unstable; urgency=low

  * dpkg-dev-el:
   - debian-changelog-mode.el: Allow tilde (~) in version numbers", thanks
     to Rafael Laboissiere for the report and to Peter Samuelson for the
     patch (Closes: #382514).
  * emacs-goodies-el:
    - folding.el: Updated to latest CVS version.

 -- Peter S Galbraith   Mon, 11 Sep 2006 12:02:32 -0400

emacs-goodies-el (26.7-1) unstable; urgency=low

  By Jaakko Kangasharju :
  * gnus-bonus-el:
    - Verify gnus-newsgroup-name is set before using it (Thanks to Elias
      Oltmanns) (Closes: #384402)
  By Junichi Uekawa :
  * debian-el:
    - debian-changelog-mode.el: Does not support bugs with only e-mail
      address and no full name. (Closes: #380217).
  By Peter S Galbraith :
  * debian-el:
    - apt-utils.el: New upstream release 2.8.0:
    - debian-bug.el: Bug fix: "debian-el: debian-bug-prompt-bug-number
      missing word-at-point", thanks to Kevin Ryde (Closes: #384542).
  * emacs-goodies-el:
    - Bug fix: minor info manual error", thanks to Sebastian Luque
      (Closes: #385234).

 -- Peter S Galbraith   Tue,  5 Sep 2006 20:53:27 -0400

emacs-goodies-el (26.6-1) unstable; urgency=low

  * dpkg-dev-el:
    - readme-debian.el: (Changed by Junichi Uekawa )
      set locale to C for obtaining rfc822-style date, follow-up for
      fix for 351010. (closes: #364770)
    - remove duplicate add-to-list for auto-load-alist.
      (Changed by Junichi Uekawa )
    - readme-debian.el: Better regexp to activate on *.Debian$ files".
      Thanks to Jari Aalto for the bug and the patch (Closes: #354970).
    - "utf-8 for debian/control file", thanks to Kevin Ryde (Closes: #365796).
  * emacs-goodies-el:
    - Bug fix: "Modify emacs-goodies-el's dependency on bash to allow
      bash-static instead", thanks to maru dubshinki (Closes: #364852).
  * gnus-bonus-el:
    - Bug fix: "not fully installed message in e,acs-snapshot", thanks to
      Dan Jacobson (Closes: #369618).
  * debian-el:
    - debian-bug.el: "Change the face of Tags: for experimental", thanks to
      Luca Capello for the bug and patch (Closes: #357265).

 -- Peter S Galbraith   Tue, 30 May 2006 19:43:18 -0400

emacs-goodies-el (26.5-2) unstable; urgency=low

  * Bug fix: "dpkg-dev-el: Error message during configuration of
    emacs-snapshot", thanks to Sven Joachim for reporting this.
    It Turns out that the /etc/emacs/site-start.d/ startup files were
    trying to load byte-compiled files in
    /usr/share/emacsFLAVOR/site-lisp/PACKAGE directories that don't exist
    because the package hasn't been fully installed yet.  I now check for
    this condition. (Closes: #341829).

 -- Peter S Galbraith   Tue, 21 Feb 2006 21:24:10 -0500

emacs-goodies-el (26.5-1) unstable; urgency=low

  * dpkg-dev-el:
    - readme-debian.el: Update date not in RFC822 format.
      Thanks to Luca Capello for the bug report and patch (Closes: #351010).
  * debian-el:
    - deb-view.wl: Bug fix: Fails if coding system utf-8 is preferred.
      Thanks to Sven Joachim for the report and the patch (Closes: #344260).
  * emacs-goodies-el:
    - emacs-goodies-el: Bug fix: home-end-enable defcustom clobbers bindings.
      Thanks to Matt Hodges for the bug report (Closes: #340694).
    - edit-env.el: Symbol's function definition is void: copy-list.
      Thanks to Sven Joachim for the bug report (Closes: #340735).

 -- Peter S Galbraith   Thu,  2 Feb 2006 22:13:10 -0500

emacs-goodies-el (26.4-1) unstable; urgency=low

  * debian-el:
    - debian-bug.el: Swap "^CC:" for X-Debbugs-CC: in mail header.
      Thanks to Luca Capello (Really closes: #208570).
  * dpkg-dev-el:
    - debian-control-mode.el: Make # the comment character.
      Thanks to Romain Francoise for the suggestion (Closes: #339868).

 -- Peter S Galbraith   Tue, 22 Nov 2005 20:59:11 -0500

emacs-goodies-el (26.3-1) unstable; urgency=low

  * emacs-goodies-el:
    - Info manual concerning under.el: s/underline-region/underhat-region/
      in info page", thanks to Luca Capello (Closes: #336938).
    - Leaves temporary file behind if already configured", thanks to
      Romain Francoise for the report and the patch (Closes: #336830).
  * debian-el:
    - debian-bug.el: Use bug number under point as prompt default whenever
      possible.  Thanks to Luca Capello (Closes: #337233).
    - debian-bug.el: Swap CC: for X-Debbugs-CC: in mail header.
      Thanks to Francesco Potorti` (Closes: #208570).
    - debian-bug.el: debian-bug-wnpp must skip over mml directives in
      new mail drafts. Thanks to Luca Capello for reporting (Closes: #337659)
    - gnus-BTS.el: Invalid function macro trying to view an article.  I
      wasn't skipping byte-compilation for gnus-BTS.el, I was skipping
      installation!  I added a new method to install yet skip
      byte-compilation.  Thanks to Luca Capello (Closes: #336935).
    - apt-utils.el: New upstream release:
      Files in apt-utils-search-file-names are now hyperlinks;
      New command, apt-utils-view-version, to report the installed version
      of a package.

 -- Peter S Galbraith   Sat,  5 Nov 2005 13:12:35 -0500

emacs-goodies-el (26.2-1) unstable; urgency=low

  * emacs-goodies-el:
    - slang-mode.el: Bad default for slang-default-application. Thanks to
      Sven Joachim (Closes: #336352).
    - htmlize.el: New upstream version 1.27.
      Thanks to Hrvoje Niksic (Closes: #336356).
  * debian-el:
    - debian-bug.el: debian-bug-package must skip over mml directives in
      new mail drafts. Thanks to Luca Capello for reporting (Closes: #336466)

 -- Peter S Galbraith   Sun, 30 Oct 2005 20:49:34 -0500

emacs-goodies-el (26.1-1) unstable; urgency=low

  * New package vm-bonus-el: Miscellaneous add-ons for VM.
    - vm-rfaddons.el: a collections of various useful VM helper functions.
    - u-vm-color.el: font-lock support for VM.
    Thanks to Patrice Karatchentzeff for the suggestion. (Closes: #244444)
  * Removed transitional packages:
     emacs-goodies-extra-el, debbugs-el and debview
  * debian-el:
    - deb-view.el V1.12:  Bug fixes suggested by Dan Jacobson.
      + Output an error message if the package file is corrupted
        (e.g. partial download) (Closes: #235673).
      + deb-view-dired-view: Check if file in dired is a .deb before opening
        (Closes: #273902).
      + deb-view-tar-view: If the file to be opened is from the INFO buffer,
        then open in the other (larger) window (Closes: #321869).
    New files:
    - pressed.el: a major mode for editing debian-installer preseed files.
      Thanks to W. Borgert  for suggesing and providing it.
      (Closes: #279061)
  * dpkg-dev-el:
    - 50dpkg-dev-el.el: Only apply utf-8 coding-system if it exists.
  * emacs-goodies-el:
    - matlab.el: New upstream version, updated to 3.0.1
    - boxquote.el: New upstream version, updated to 1.18,
      Thanks to Simon Taylor (Closes: #335070).
    - bar-cursor.el bug fix: In my previous fix, I forgot to undo skipping
      installation for emacs-snapshot (Closes: #331430).
    New files:
    - maple.el: major mode for editing Maple files. Thanks to Anders
      Lennartsson for suggesting it (Closes: #334425).
    - color-theme.el: changes the colors used within Emacs (Closes: #144420).

 -- Peter S Galbraith   Tue, 25 Oct 2005 22:08:16 -0400

emacs-goodies-el (25.1-1) unstable; urgency=low

  * General Bug fix: "compiling *.el files should display errors, not just
    log file name", thanks to Jari Aalto (Closes: #309790).  I implemented
    the suggested grep for byte-compilation warnings and now delete the
    temporary log files after their creation ("debian-el: leaves temporary
    files in /tmp after installation", thanks to Lars Wirzenius; Closes:
    #331114).
  * emacs-goodies-el:
    - emacs-goodies-el.el: Key binding for wdired didn't get properly
      defined in emacs-snapshot, thanks to Sven Joachim for the report and
      the patch (Closes: #329883).
    - dict.el: `current-word' can return nil", thanks to Jorgen Schaefer
      for the report and patch. (Closes: #301293).
    - shell-command.el: New upstream version.  Also fixed bug "activation
      is documented wrongly" from Sven Joachim.  The activation has changed
      to using the variable `shell-command-completion-mode'. (Closes: #331421)
    - bar-cursor.el bug fix: Loading the library changes cursor to hollow
      box in emacs-snapshot", Thanks to Sven Joachim for the report and the
      patch (Closes: #331430).
    New files:
    - cfengine.el: major mode for editing cfengine files.
      Thanks to Morten Werner Olsen (Closes: #280415).
    - csv-mode.el: major mode for editing comma-separated value files
      (Closes: #260705)
    - cua.el: emulate CUA key bindings (C-z undo, C-x cut, C-c copy, C-v paste)
    - cwebm.el:  a CWEB/WEB modified mode.
      Thanks to Max Vasin (Closes: #326772).
    - ido.el: a faster way to switch buffers and get files.
      Thanks to Cyril Bouthors (Closes: #293732).
    - matlab.el: a major mode for MATLAB dot-m files
      tlc.el: a major mode for editing Target Language Compiler scripts
      Thanks to Riccardo Vestrini (Closes: #246379).
    - minibuf-electric.el:  Electric minibuffer behavior from XEmacs.
      Thanks to Karl Hegbloom (Closes: #317566).
    - slang-mode.el: a major-mode for editing slang scripts.
      Thanks to Rafael Laboissiere (Closes: #297828).
    - tabbar.el: Display a tab bar in the header line.
      Thanks to Josh Triplett for both suggestions and a patch
      (Closes: #237341).
  * gnus-bonus-el: (Jaakko Kangasharju )
    - gnus-filterhist.el: Move face-changing command inside temporary buffer
      manipulation (Closes: #331234)

 -- Peter S Galbraith   Sat, 15 Oct 2005 15:31:53 -0400

emacs-goodies-el (24.15-2) unstable; urgency=low

  * symlink .el files alongside .elc files such that they are available
    for `find-function' et al.  (Closes: #329114 again)

 -- Peter S Galbraith   Thu, 22 Sep 2005 21:23:58 -0400

emacs-goodies-el (24.15-1) unstable; urgency=low

  * gnus-bonus-el:
    - no longer add /usr/share/emacs/site-lisp/gnus-bonus-el to load-path
      since that shadows emacs-snapshot packages nnnil.el and spam-stat.el
    - skip byte-compilation for unsupported emacs20.  Thanks to Thomas
      Bushnell BSG for reporting it and noticing the Emacs20 involvement.
      (Closes: #329430).
  * emacs-goodies-el:
    - Fix buglet in `wdired-enable' setting.

 -- Peter S Galbraith   Wed, 21 Sep 2005 19:32:28 -0400

emacs-goodies-el (24.14-1) unstable; urgency=low

  * dpkg-dev-el:
    - debian-bts-control.el: Pick bug number at point for debian-bts-control
      messages", thanks to Jari Aalto for the idea and patch (Closes: #325095).
  * emacs-goodies-el:
    - no longer add /usr/share/emacs/site-lisp/emacs-goodies-el to load-path
      since that shadows emacs-snapshot packages such as ibuffer and others.
      (Closes: #329114)

 -- Peter S Galbraith   Tue, 20 Sep 2005 21:44:18 -0400

emacs-goodies-el (24.13-1) unstable; urgency=low

  * debian-el:
    - debian-bug.el: debian-bug-build-bug-menu was broken from BTS HTML
      format changes (Closes: #329034).
    - gnus-BTS.el:  Minor bug fix preventing byte-compilation on
      emacs-snapshot.
  * dpkg-dev-el:
    - Handle changelog coding system for debian native package, by Kevin
      Ryde (Closes: #317597).
    - debian-changelog-mode.el: Add outline-regexp and C-cC-n and C-cC-p
      movement commands as suggested by Romain Francoise (Closes: #322994)
  * emacs-goodies-el:
    - tld.el: new upstream version omits FX which does not exist,
      thanks to Stephane Bortzmeyer for reporting this (Closes: #273588).
    - Skip byte-compilation for wdired.el ibuffer.el table.el newsticker.el
      for emacs-snapshot, since it has these files (Same for package
      gnus-bonus-el and files nnnil.el and spam-stat.el). Also only define
      the "r" key in dired-mode if `emacs-goodies-el-defaults' is set.
      (Closes: #329114)

 -- Peter S Galbraith   Mon, 19 Sep 2005 19:25:31 -0400

emacs-goodies-el (24.12-1) unstable; urgency=low

  * No longer call (setq load-path (substitute "." nil load-path)) in startup
    scripts since it's no longer useful and required 'cl to work correctly.
    Thanks to Kevin Ryde for finding this and reporting it! (Closes: #328712)
  * emacs-goodies-el:
    - newsticker.el: new upstream version 1.8
    - ff-paths.el: new upstream version 3.23
    - emacs-goodies-el.el: Double entry in Dired menu on Emacs 22 fixed by
      Sven Joachim (Closes: #323754)
    - perldoc.el: Apply patch from Kevin Ryde for when perldoc package is
      not installed. (Closes: #314869)
  * devscripts-el: (Changed by Junichi Uekawa )
    - minor cosmetic fix on output of pbuilder-build command; add a missing
      newline
  * debian-el:
    - gnus-BTS: Emacs namespace is being polluted (incorrect
      naming of funcs/vars).  Thanks to Jari Aalto for the updated file.
      (Closes: #324116)
  * gnus-bonus-el:
      dependency compatible with emacs-snapshot.
      Thanks to Luca Capello.  (Closes: #322536)
  * dpkg-dev-el:
      debian-changelog-mode.el: Apply patch from Rafael Laboissiere adding
      debian-changelog-add-version-hook defaulting to
      debian-changelog-add-new-upstream-release (Closes: #296725)

 -- Peter S Galbraith   Sun, 18 Sep 2005 19:47:11 -0400

emacs-goodies-el (24.11-2) unstable; urgency=low

  * emacs-goodies-el:
    - perldoc.el: Handle case when perl-doc is not installed", thanks to
    Kevin Ryde for the report and a stab at fixing it (Closes: #314869).

 -- Peter S Galbraith   Thu, 23 Jun 2005 19:14:00 -0400

emacs-goodies-el (24.11-1) unstable; urgency=low

  * debian-el:
   - apt-utils.el: "apt-utils-show-package is broken", thanks to Thamer
     Mahmoud for reporting it and to Matt Hodges for fixing it in a new
     upstream version (Closes: #302888, #312000).
  * devscripts-el: (Changed by Junichi Uekawa )
   - autoload 'debi'; fix spelling mistake in pduilder->pbuilder
     (closes: #305109)
  * dpkg-dev-el:
   - debian-changelog-mode.el: "`(fboundp (quote imenu))' called for
     effect", thanks to Jari Aalto for the patch (Closes: #309788).
   - 50dpkg-dev-el.el: Make debian changelogs default to utf-8,
     thanks to Kevin Ryde for the patch (Closes: #315494).

 -- Peter S Galbraith   Thu, 23 Jun 2005 13:00:40 -0400

emacs-goodies-el (24.10-1) unstable; urgency=low

  * debian-el:
    - debian-bug.el: Patch from Kevin Ryde  adds gnus
      support to debian-bug-get-bug-as-email, bringing the bug
      messages up in a gnus group. (Closes: #288469)
  * emacs-goodies-el:
    - apache-mode.el: Bug fix: "emacs-goodies-el: uncomment-region does
      not work with closing tags like ", thanks to Cyril
      Bouthors for reporting this (Closes: #283840).  The bug is fixed by
      switching to a new version now maintained by Karl Chen.
  * dpkg-dev-el:
    - debian-control-mode.el: Bug fix: "mouse-pasting fails and starts
      Mozilla in Debian control mode", thanks to Antti-Juhani Kaijanaho
      (Closes: #293629).  I changed the binding from mouse-2 to C-mouse-2.

 -- Peter S Galbraith   Mon,  7 Feb 2005 21:27:58 -0500

emacs-goodies-el (24.9-2) unstable; urgency=low

  * Use debian-emacs-flavor instead of flavor in startup files and replace
    occurrences of nil by "." in load-path for the sake of
    debian-pkg-add-load-path-item.

 -- Peter S Galbraith   Wed, 15 Dec 2004 21:04:21 -0500

emacs-goodies-el (24.9-1) unstable; urgency=low

  * emacs-goodies-el:
    - todoo.el: outline-regexp improperly made buffer-local,
      thanks to Cyril Bouthors for reporting (Closes: #284083).

 -- Peter S Galbraith   Fri,  3 Dec 2004 15:30:07 -0500

emacs-goodies-el (24.8-1) unstable; urgency=low

  * debian-el:
    - apt-utils.el: Updated to latest version from Matt, in which he fixed
      dependence on jka-compr (Closes: #278929) and addressed the issue of
      memory usage (Closes: #252481).
  * emacs-goodies-el:
    - todoo.el: changes to outline-regexp should be buffer-local
      (Closes: #267637).  Thanks to Daniel Skarda <0rfelyus@hobitin.ucw.cz>
      for pointing it out.
    - folding.el: Updated to latest CVS version to fix bug: "folding.el:
      support for BibTeX-mode is b0rken", thanks to Juhapekka Tolvanen
      (Closes: #282388).

 -- Peter S Galbraith   Thu, 25 Nov 2004 22:06:03 -0500

emacs-goodies-el (24.7-1) unstable; urgency=low

  * debian-el:
    - apt-utils.el: new upstream version from Matt.
    - debian-bug.el: Bug fix: "debbugs-el: M x debian-bug fails due to new
      reportbug syntax; Add "--list-cc=none" to call to reportbug".
      Thanks to Camm Maguire for the patch (Closes: #280780).
  * emacs-goodies-el:
    - newsticker.el: New upstream release (1.6).

 -- Peter S Galbraith   Fri, 12 Nov 2004 15:41:48 -0500

emacs-goodies-el (24.6-2) unstable; urgency=low

  * gnus-bonus-el
    - Attempt to fix Bug: "gnus-bonus-el: search-failed "--text follows this
      line--". Thanks to Mathieu Roy for reporting, and email back if the
      fix doesn't work for you (Closes: #240212).
  * Bug fix: "wrong emacsen-install, so logging will fail",
    emacsen-install.template used shell-specifix redirection. Thanks to
    OHASHI Akira for reporting and providing the fix (Closes: #265478).

 -- Peter S Galbraith   Mon, 16 Aug 2004 21:06:11 -0400

emacs-goodies-el (24.6-1) unstable; urgency=low

  * gnus-bonus-el
    - Bug fix: "Missing file: nnmaildir.el", thanks to Christian Joergensen
      for reporting this.  The file is actually in the gnus package so I
      won't mention it anymore. (Closes: #256260).
  * debian-el:
    - debian-el.el: Bug fix: "debian-el: Add udeb support to debview",
      thanks to Frédéric Botha-my for the suggestion and patch
      (Closes: #260273).
    - apt-utils.el: new upstream version from Matt, adds "m" key and menu
      entry to read man page.  Addresses bug report "apt-utils.el: not
      friendly" from Dan Jacobson (Closes: #249061).
    - debian-bug.el: debian-bug-wnpp now supports RFH tag (Closes: #262985).
  * emacs-goodies-el:
    - Since todoo.el and ibuffer.el don't work in XEmacs, do autoload
      them and document that limitation in the Info docs. Thanks to OHURA
      Makoto for reporting (Closes: #244681).

 -- Peter S Galbraith   Tue,  3 Aug 2004 20:26:21 -0400

emacs-goodies-el (24.5-1) unstable; urgency=low

  * debian/control: Added Jérôme Marant  to uploaders.
  * debian/changelog: Converted to UTF-8 as per Policy.
  * debian/emacsen-install.template: Since dashes are not allowed in
    flavour names within shell variables, replace them with underline
    characters. (Jérôme Marant).
  * dpkg-dev-el:
    - debian-changelog-mode.el: "dpkg-dev-el: Warning message for security
      uploads should be dismissed".  Thanks to Martin Schulze (Closes: #234730)
    - debian-changelog-mode.el: "Should mark line beginning with a tab as
      invalid". Thanks to Michel Daenzer (Closes: #235310).

 -- Jerome Marant   Sun, 16 May 2004 14:00:45 +0200

emacs-goodies-el (24.4-1) unstable; urgency=low

  * dpkg-dev-el:
    - debian-control-mode.el: Apply patch from Jhair Tocancipa Triana
       to fix an after-change-functions race
      (Closes: #226770, #236506).
  * emacs-goodies-el:
    - emacs-goodies-custom.el:  Remove duplicate and obsolete entries
      for joc-toggle-buffer and joc-toggle-case defcustoms. Thanks to
      Kevin Ryde for reporting it (Closes: #234972).
    - joc-toggle-buffer.el: Provide joc-toggle-buffer instead of older name
      toggle-buffer. Thanks to Kevin Ryde for reporting it (Closes: #234971).
    - emacs-goodies-el.texi: Rename node auto-fill-mode-inhibit to
      auto-fill-inhibit and pack-window to pack-windows.  Thanks to
      Kevin Ryde  for reporting it (Closes: #234651).

 -- Peter S Galbraith   Sat, 27 Mar 2004 19:59:41 -0500

emacs-goodies-el (24.3-1) unstable; urgency=low

  * debian-el:
    - apt-utils.el: Updated to v1.82 (2004/02/17). Bug fix: "debian-el:
      (args-out-of-range 922 922)", thanks to Johannes Rohr for reporting it
      (Closes: #232367).  Also adds automatic rebuilding of its APT package
      list; See `apt-utils-automatic-update'.
  * gnus-bonus-el:
    - Bug fix: No longer depend on emacs20 since it was removed from
      testing, thanks to Martin Michlmayr for reporting it (Closes: #232760).
  * dpkg-dev-el:
    - debian-changelog-mode.el: Add file NEWS.Debian to auto-mode-alist.
      Thanks to Chris Lawrence for suggesting it (Closes: #233310).

 -- Peter S Galbraith   Thu, 19 Feb 2004 21:28:32 -0500

emacs-goodies-el (24.2-2) unstable; urgency=low

  * gnus-bonus-el:
    - gnus-pers.el bug fix: Use functionp instead of relying on
      message-functionp being provided by gnus, since recent gnus no longer
      has it. Thanks to Brian May for reporting (Closes: #230036).

 -- Peter S Galbraith   Wed, 28 Jan 2004 19:53:18 -0500

emacs-goodies-el (24.2-1) unstable; urgency=low

  * debian-el:
    - apt-utils.el: Updated to v1.78 (2004/01/04). Allow for multiple
      buffers in apt-utils-mode that are independent of one another.
      Also fix bug: "debian-el: apt-utils-show-package scrolling", thanks to
      Kevin Ryde for reporting it (Closes: #225610).
    - deb-view.el: Resize top (control) window to fit number of lines since
      it doesn't really need to be 1/2 the screen. Thanks to Dan Jacobson
      for suggesting this change (Closes: #224950).
  * emacs-goodies-el:
    - browse-kill-ring.el: cannot setup `*Kill Ring*' buffer with items
      propertized read-only", many thanks to INOUE Hiroyuki for reporting it
      along with a working fix (Closes: #225082).
    - coffee.el: Since `M-x coffee' doesn't work for real, I've removed
      its autoload so users can't trip on it accidentally, and I've made it
      clear it's a joke package in the Info docs. Thanks to Daniel de
      Angelis Cordeiro for reporting (Closes: #225152).

 -- Peter S Galbraith   Fri, 16 Jan 2004 15:32:06 -0500

emacs-goodies-el (24.1-1) unstable; urgency=low

  * debian-el:
    - apt-sources.el: Remove problematic requirement on autoinsert.el
      since it's not needed and upstream said he had removed it (but hadn't).
  * dpkg-dev-el:
    - debian-changelog-mode.el: Bug fix: "error setting distribution
      to *-security", thanks to Yann Dirson for reporting (Closes: #224187).
  * emacs-goodies-el:
    - browse-kill-ring.el bug fix: "can't delete entries with `read-only'
      text property (on emacs21.1)", thanks to INOUE Hiroyuki for the report
      and the patch (Closes: #224751).
  * devscripts-el: (Prepared by Junichi Uekawa)
    - debdiff-current: Run debdiff against the previous version found in
      the changelog.
  * gnus-bonus-el:
    - gnus-pers.el bug fix: "Uses message-functionp instead of functionp",
      thanks to Brian T. Sniffen (Closes: #223493).
    - gnus-pers.el bug fix: "There is no 'replace-in-string' as called by
      gnus-pers.el", thanks to Brian T. Sniffen (Closes: #223494).

 -- Peter S Galbraith   Mon, 22 Dec 2003 21:00:30 -0500

emacs-goodies-el (24.0-1) unstable; urgency=low

  * emacs-goodies-el:
    - toggle-buffer.el renamed to joc-toggle-buffer.el
    - toggle-case.el renamed to joc-toggle-case.el
    New files:
    - minibuffer-complete-cycle.el, cycle through possible completions.
      Thanks to Hisashi MORITA for suggesting it and to Kevin Rodgers for
      accepting my suggestions to the code.  Half of #217371.
    - lcomp.el, list-completion hacks. Thanks to Hisashi MORITA for
      suggesting it (Closes: #217371).
    - folding.el, a folding-editor-like minor mode. Thanks to Michael Vogt
      (Closes: #161404) and to Jérôme Marant (Closes: #170587) for the
      suggestion.
    - apache-mode.el, major mode for editing Apache configuration files
      Thanks to Jérôme Marant for suggesting it (Closes: #165316).
    - ctypes.el, Enhanced Font lock support for custom defined types.
      Thanks to Toby Speight (for suggesting it Closes: #212884).
    - shell-command.el, enables tab-completion for shell-command.
      Thanks to Ole Laursen for suggesting it abd to its author TSUCHIYA
      Masatoshi for accepting suggestions for changes (Closes: #219766).
    - browse-huge-tar.el, browse tar files without reading them memory.
      Thanks to Marcus Crafter for suggesting it (Closes: #161159):
     Thanks to John Wiegley for suggesting files below (Closes: #137910):
    - edit-env.el, view and edit environment variables.
    - dedicated.el, dedicate a window to a single buffer.
    - rfcview.el, view IETF RFCs with readability-improved formatting.
      (Also thanks to Kevin Ryde for this suggestion; Closes: #222186)
    - marker-visit.el, navigate through a buffer's marks in order.
    - pack-windows.el, resize all windows to display as much info as possible.
    - ascii.el, ASCII code display for character under point.
    New upstream versions:
    - ff-paths.el: New variables to skip running locate for find very
      common file names.  Thanks to Stephen Eglen for suggesting it.
      (Closes: #220507)
    Patches:
    - 50_todoo_bug220718: Fix XEmacs keybindings for XEmacs.
      Thanks to Gianluca Della Vedova (Closes: #220718).
    - 50_joc-toggle-buffer: Add prefix joc- where missing; Fix startup bug.
    - 50_joc-toggle-case: Add prefix joc- where missing.
    - 50_silly-mail: Add custom support.
    Info manual:
    - filladapt.el: Document how to use with C, thanks to Kevin Ryde for the
      patch (Closes: #221942).
    - Document joc-toggle-buffer, joc-toggle-case, silly-mail.
  * dpkg-dev-el:
    - debian-changelog-mode.el: Make `debian-changelog-add-entry' works
      from files in unpacked sources.  Thanks to Junichi Uekawa for
      suggesting it (Closes: #220641).
      Add menu entry for "Archived Bugs for This Package", for
      "Developer Page for This Package", "Developer Page for This Maintainer".
    - debian-control-mode.el: highlight only known fields (Closes: #213779).
    - debian/control: dpkg-dev-el depends on debian-el (>= 24.0-1) for
      debian-changelog-mode using debian-bug-web-developer-page.
  * debian-el
    - apt-utils.el: Updated to v1.72 (2003/11/25). More robust finding of
      ChangeLog and README files, and new commands to find NEWS and
      copyright files.
    - debian-bug: Thanks to Kalle Olavi Niemitalo for both these bug
      reports with working patches.  :-)
      - Contain debian-bug's cursor-in-echo-area to when it's needed so the
        list of pseudo-packages can be scrolled. (Closes: #222332)
      - debian-bug-package: Let M- and M- scroll the pseudo-package
        list window by making _it_ the other window. (Closes: #222333)
    - debian-bug.el: Add menu entry for "Archived Bugs for This Package", for
      "Developer Page for This Package", "Developer Page for This Maintainer"
      (Closes: #222391).
  * make-orig.sh bug fix: "cvs .# files in source package", thanks to
    Kevin Ryde for reporting it (Closes: #221940).

 -- Peter S Galbraith   Sun,  7 Dec 2003 14:38:09 -0500

emacs-goodies-el (23.1-1) unstable; urgency=low

  * debian-el:
    - deb-view.el: I'm now maintaining this file. New version supports
      customization.
    - debian-bug.el bug fix: "Should send minor severty bugs to maintonly,
      not submit", thanks to Tollef Fog Heen (Closes: #214242).
    - debian-bug.el bug fix: "M-x debian-bug prompt doesn't work correctly
      in XEmacs21", thanks to Kenshi Muto for reporting (Closes: #219811).
  * emacs-goodies-extra-el:
    - Re-introduce a harmless 50emacs-goodies-extra-el.el file since old one
      not removed in dist-upgrade.
  * emacs-goodies-el:
    - tc.el: upstream-approved edits.  Includes new cite attribution string.
  * dpkg-dev-el:
    - Edits *all* elisp files in package to add autoload tags.
    - Create `dpkg-dev-el.el' and `dpkg-dev-el-loaddefs.el' startup files
      and use them in Emacs startup.

 -- Peter S Galbraith   Tue, 11 Nov 2003 19:08:37 -0500

emacs-goodies-el (23.0-1) unstable; urgency=low

  * gnus-bonus-el: (Prepared by Jérôme Marant)
    New files:
    - gnus-pers.el, an alternative to gnus-posting-styles. (Closes: #166459)
    - gnus-eyecandy.el, enhance the group buffer by adding icons.
    - gnus-filterhist.el, add a buffer which display the message filtering
      history.
    Debian setup:
    - Add autoloads for gnus-pers.el, gnus-eyecandy.el and gnus-filterhist.el.
  * emacs-goodies-el:
    - htmlize.el: new upstream version 1.16 with many enhancements.
    Patches:
    - 50_newsticker_non-fatal_xml: Don't bail out requiring xml which doesn't
      exists on woody XEmacs. Fixes Bug "M-x newsticker-start crashes",
      reported by Volker Linke and fixed thanks to advice from Matt Hodges
      (Closes: #216233).
    - 50_projects: Make projects.el less intrusive by default.  Rename
      commands to have `project-' prefix.
    Info manual:
    - documented projects.el and tc.el.
  * devscripts-el: (Prepared by Junichi Uekawa)
    - implement 'debdiff'
    - devscripts-el.README.Debian: update to reflect latest changes.
  * debian-el:
    - apt-sources.el: new upstream version 0.9.8.
    - 50debian-el.el renamed to 51debian-el.el to make sure it runs
      _after_ old version of 50debview.el.
    - Bug fix: "debbugs-el: gnus-BTS.el causes error on opening article",
      thanks to Johannes Rohr for reporting this (Closes: #218227).  We no
      longer byte-compile gnus-BTS.el since it uses gnus macros and this
      breaks if byte-compiled with one version of gnus and used with
      another.
  * debview:
    - Bug fix: Re-introduce an harmless 50debview.el file since old one
      not removed in dist-upgrade and autoloaded debview from wrong place.
      Thanks to Neil Roeth (Closes: #218094).

 -- Peter S Galbraith   Thu, 30 Oct 2003 19:58:16 -0500

emacs-goodies-el (22.2-1) unstable; urgency=low

  * devscripts-el:
    - Bug fix in packaging: "byte-compilation failures (e20 at least)",
      thanks to Aaron M. Ucko for reporting.  We'll use full Debian setup of
      Emacs packages to byte-compile devscripts-el (Closes: #216037).
  * dpkg-dev-el:
    - Bug fix: "View upgrading-checklist: fails to decompress", thanks to
      Neil Roeth for the thorough report.  Fixed by forcing
      auto-compression-mode on all flavours of Emacs (Closes: #216040).
  * debian/control bug fix: Package descriptions pointed to README.Debian.gz
    but the files were not compressed, thanks to Jaume (Closes: #216055).
  * debian/*emacsen-install*: Add STAMPFILE and don't byte-compile files
    if already done.

 -- Peter S Galbraith   Thu, 16 Oct 2003 13:17:13 -0400

emacs-goodies-el (22.1-1) unstable; urgency=low

  * emacs-goodies-el:
    New upstream versions:
    - tc.el:  Version 0.13.3.
    - table.el:  Version 1.5.54.  Wow! This is a very cool package!
    - tail.el: Benjamin Drieu gave me carte blanche to hack on it, so I
      fixed a few bugs, including making it under XEmacs. Thanks to Adam
      Sjögren for reporting this bug (Closes: #164372).
    - under.el: checkdoc clean; add autoload tag; don't make global
       variables; rename underline-region to underhat-region since it
       overloaded an existing Emacs21 command.
    - htmlize.el: Bug fix "emacs-goodies-el: htmlize-* doesn't appear to
      work in TTY", thanks to Gergely Nagy for reporting it (Closes: #127943).
    - framepop.el: Don't enable it on non-window Emacs.
    Patches:
    - nuke-trailing-whitespace.el: Add custom interface support with ability
       to install into write-file-hooks.
    - protbuf.el: Add custom interface support and make interactive
       commands true toggles.
    - table.el: Add table-add-to-text-mode-hook defcustom.
    - session.el: Remove autoload tag for a defmacro.
    - setnu.el: add defface and checkdoc edits.
    Info manual:
    - documented nuke-trailing-whitespace, protbuf, protocols, services,
      setnu, sys-apropos, table, tail, thinks, tld, todoo, toggle-option,
      twiddle, under, wdired, xrdb-mode.
  * debian-el:
    New upstream versions:
    - debian-bug.el: decode ISO strings in Debian BTS for properly
      formatted Thanks in debian-changelog-mode.el.

 -- Peter S Galbraith   Wed, 15 Oct 2003 21:55:34 -0400

emacs-goodies-el (22.0-1) unstable; urgency=low

  * Package `emacs-goodies-extra-el' now a transitional package.  Its
    contents are merged into `emacs-goodies-el'.
  * New binary package `debian-el' holds contents of old `debbugs-el' (now
    a transitional package) along with apt-sources.el and apt-utils.el
    formely from `emacs-goodies-el'.
  * New transitional package `debview' to replace old `debview' source
    package since package debian-el now holds deb-view.el.  ftp-masters,
    please see bug #214311.
  * New file in emacs-goodies-el: newsticker.el, a news ticker for Emacs.
  * New file in emacs-goodies-el: framepop.el, display temporary buffers
    in a dedicated frame.
  * New file in emacs-goodies-el: session.el, a menu to restore files
    visited in previous editing session. Thanks to Lennart Poettering for
    suggesting it (Closes: #186639).
  * Bug fix: "debian-el: debian-bug-search-file: should use dlocate when
    available", thanks to Jeff Sheinberg (Closes: #211598).  Added dlocate
    to package Recommends.
  * emacs-goodies-el: Since XEmacs has it's own version of ibuffer, make
    sure we don't shadow it.  Added its directory to load-path in
    50emacs-goodies-el.el.  Also for ibuffer: a customization variable
    (ibuffer-enable) was created to bind it to \C-x\C-b, and its
    documentation was added to the emacs-goodies-el Info.
  * emacs-goodies-el: dict.el new upstream version, merges in Debian patch.
  * emacs-goodies-el: keywiz.el new upstream version 1.4.
  * emacs-goodies-el: mutt-alis.el new upstream version 1.4. Almost
    checkdoc clean.
  * Bug fix: "emacs-goodies-el: perldoc does not work - terminal is not
    fully functional due to perldoc setting a pager", thanks to Sebastian
    Schütte for reporting and to Alan Shutko  for
    contributing the fix (Closes: #144963).
  * emacs-goodies-el: perldoc.el rewrite to get Perl function name on the
    fly from the perlfunc.pod file.
  * debian-bug.el and debian-bts-control.el: Add `sarge-ignore' and
    `fixed-upstream' tags.
  * Junichi Uekawa
  - devscripts-el: integrate upstream release (Closes: #208974).
    pbuilder-log-view.el
    pbuilder-mode.el
    devscripts.el
  - 7_devscripts-debuild-uc-us.dpatch devscripts incorporated upstream.
  - 9_missing_provide.dpatch remove part about devscripts.
  - devscripts-el: Depend on elserv.

 -- Peter S Galbraith   Mon,  6 Oct 2003 20:16:42 -0400

emacs-goodies-el (21.12-1) unstable; urgency=low

  * emacs-goodies-el's highligh-current-line.el is now a minor-mode,
    enhanced by yours truly.  Add highlight-current-line to Info docs.
  * emacs-goodies-el's highligh-beyond-fill-column.el: upstream approved
    code cleanup.  Created `highligh-beyond-fill-column' to activate it.
    Added to Info docs.
  * emacs-goodies-el's home-end.el: Bug fix: "home-end-enable shouldn't
    unset end and home!", thanks to Jorgen Schäfer 
    (Closes: #211859).  Add to Info docs.
  * dpkg-dev-el: setup auto-mode-alist better for README.Debian and
    copyright files.

 -- Peter S Galbraith   Sat, 20 Sep 2003 19:49:55 -0400

emacs-goodies-el (21.11-1) unstable; urgency=low

  * dpkg-dev-el's debian-bts-control.el adds package', 'owner' and
    'noowner' commands.

 -- Peter S Galbraith   Thu, 18 Sep 2003 22:40:53 -0400

emacs-goodies-el (21.10-1) unstable; urgency=low

  * debbugs-el's debian-bug.el: http://bugs.debian.org HTML code changed a
    bit and broke my parser.  Fixed.

 -- Peter S Galbraith   Wed, 17 Sep 2003 20:41:19 -0400

emacs-goodies-el (21.9-1) unstable; urgency=low

  * debbugs: debian-bug-filename adds File: info to informational block in
    draft bug report.
  * debbugs, debbugs-el.emacsen-startup: Add autoload for useful
    debian-bug-get-bug-as-email.
  * dpkg-dev-el, debian-bts-control.el: debian-bts-help-control was missing!
  * Bug fix: "Merge debian-bug-filename into debian-bug command proper",
    thanks to Francesco Potorti` (Closes: #167214). (I'll do the
    `commands' from the PATH later.)
  * highlight-current-line.el: Updated to version V0.56
  * Update coffee.el to V0.3.
  * dpkg-dev-el, debian-changelog-mode.el: Added browse-url link to `Best
    Practices for debian/changelog' in menu.
  * dpkg-dev-el, readme-debian.el bug fix: write-contents-hooks needed to
    be made buffer-local explicitely in XEmacs ("Writes incorrect dates in
    changelog", thanks to Ross Burton. Closes: #211382).
  * patches/5_highlight-beyond-fill-column.dpatch: New patch to fix
    indentation and remove extra fontified space.

 -- Peter S Galbraith   Wed, 17 Sep 2003 15:30:25 -0400

emacs-goodies-el (21.8-1) unstable; urgency=low

  * Bug fix: "debian-bug should provide help when prompting for package
    name and severity", thanks to Mathieu Roy (Closes: #200058).
  * Bug fix: "dpkg-dev-el: debian-bts-control doesn't work on emacs20",
    Don't set `debian-bts-control-verbose-prompts-flag' to t for Emacs20
    since it can't display multi-line prompts. (Closes: #208553).
  * debbugs-el: Remove dependence on package `bug' since it no longer exists.

 -- Peter S Galbraith   Wed,  3 Sep 2003 21:19:44 -0400

emacs-goodies-el (21.7-1) unstable; urgency=low

  * Standards-Version: 3.6.1 without changes.
  * Bug fix: "dpkg-dev-el: readme-debian.el uses make-local-variable on a
    hook", thanks to Kalle Olavi Niemitalo.  Fixed upstream in
    devscripts-el-0.0.20030825 (Closes: #206993).
  * Bug fix: debian-changelog mode to support inserting bug title in
    changlog entry, such as this entry right here. Thanks to Junichi
    Uekawa (Closes: #207852).  Updated dpkg-dev-el's
    debian-changelog-mode.el and debbugs-el's debian-bug.el.

 -- Peter S Galbraith   Tue,  2 Sep 2003 22:29:29 -0400

emacs-goodies-el (21.6-1) unstable; urgency=low

  * apt-utils.el: Updated to v1.54 (2003/06/24)
  * debian-bts-control.el: add `debian-bts-control-prompt' to Prompt for
    bug number using sensible default if found (closes: #193326).
  * Add filladapt-turn-on-mode-hooks customization.
  * ff-paths.el:  Update to V3.21
  * *.emacsen-startup: Make sure that the uncompiled files are also in the
    load-path, near the end.  This is for moving point to the code when
    view help. (closes: #189754)

 -- Peter S Galbraith   Thu, 14 Aug 2003 22:45:06 -0400

emacs-goodies-el (21.5-1) unstable; urgency=low

  * patches/6_diminish-defcustom.dpatch: new defcustom tweaks sent
    upstream.
  * bar-cursor.el: A few tweaks also submitted upstream.
  * dirvars.el: Update to v1.2.  Add Info entry for it.
  * ff-paths.el: Fix setup defcustoms.
  * apt-utils.el: Updated to v1.54 (2003/06/22)
  * debian-copyright.el: Handle font-lock-defaults such that XEmacs
    doesn't fail on it (closes: #198601).

 -- Peter S Galbraith   Tue, 24 Jun 2003 15:24:34 -0400

emacs-goodies-el (21.4-1) unstable; urgency=low

  * New maintainer.  Thanks for all the work getting it this far Roland!
  * dict.el: Updated to V1.27
  * Split elisp/ directory into subdirs for each binary package.
  * emacs-goodies-loaddefs.el: Generate autoloads automatically from tags.
  * Patch some upstream files to provide themseleves (closes: #197470)
  * Add customize support to df.el and document in Info.
  * ff-paths.el:  don't install itself on load.  Add a defcustom for that.
  * Add many customize groups to `emacs-goodies-el' group.

 -- Peter S Galbraith   Tue, 17 Jun 2003 21:56:11 -0400

emacs-goodies-el (21.3-1) unstable; urgency=low

  * apt-utils.el: Updated to v1.45
  * debian-bug.el: Add `d-i', `ipv6' and `lfs' tags.
  * gnus-bonus-el.emacsen-install.in: Add directory of gnus elisp files to
    load-path during byte-compilation  (closes: #196816)
  * dpkg-dev-el.emacsen-startup: Make file named changelog.dch load
    debian-changelog-mode (closes: #196828)
  * Moved readme-debian.el from package `devscripts-el' to `dpkg-dev-el'
    such that all major modes for debian directory files are together.
  * bar-cursor.el: Edited patch sent upstream to conform the Coding
    Convention (don't enable simply by loading).
  * Added 6_diminish-defcustom.dpatch, making diminish.el configurable
    using the customize interface.  Patch sent upstream.  Also documented
    file in Info.

 -- Peter S Galbraith   Thu, 12 Jun 2003 22:02:55 -0400

emacs-goodies-el (21.2-1) unstable; urgency=low

  * Standards-Version: 3.5.10
  * debian-bts-control.el: Add `debian-bts-control-modes-to-reuse'.
  * debian-bug.el: update to V1.42
  * Added 3_bar-cursor-customize.dpatch, making bar-cursor.el enables via
    the customize interface.  Patch submitted upstream.
  * Added 5_bar-cursor-move-defcustom.dpatch, commented out the defcustom
    which I have moved and edited into emacs-goodies-el.el.  Documented in
    Info.
  * Update clipper.el to V1.1.1.
  * Update browse-kill-ring.el to 1.2 (CVS).
  * debian-control-mode.el: Add 'checklist to debian-control-visit-policy.
  * debian-changelog-mode.el: Define (really) match-string-no-properties
    for XEmacs (closes: #195181).

 -- Peter S Galbraith   Thu, 29 May 2003 13:40:27 -0400

emacs-goodies-el (21.1-1) unstable; urgency=low

  * 50emacs-goodies-el.el: Add :link to Info manual in
    `emacs-goodies-el-defaults' defcustom.
  * debian-bug.el: Add `confirmed' tag (for debian-bts-control.el).
  * debian/control: Added texinfo to Build-Depends-Indep for makeinfo
    (closes: #193272)
  * Updated debian-copyright.el from devscripts-el-0.0.20030521.tar.gz
  * Updated readme-debian.el from devscripts-el-0.0.20030521.tar.gz,
    patched it for font-lock on unstable's xemacs21, and to avoid the
    error on the case of no timestamp. Also try to get newlines
    surrounding the timestamp correctly.  Sent the file upstream to become
    the new upstream version.
  * devscripts-el.emacsen-install.in: Use APPEND_LOAD_PATH to load
    debian-changelog-mode.el during byte-compilation of readme-debian.el
  * Deleted 3_readme-debian-automode.dpatch and 6_readme-debian.dpatch
  * Updated services.el to upstream version CVS 1.4
  * Updated protocols.el to upstream version CVS 1.5
  * debian/control: Rephrase debian-bug.el description (closes: #193322)
  * Move most of 50emacs-goodies-el.el into a required emacs-goodies-el.el
    file, and wrap 50emacs-goodies-el.el around code testing if the
    package is really installed or possibly removed (and not purged).
    Same done for all other binary packages.
    (closes: #193367)

 -- Peter S Galbraith   Thu, 22 May 2003 21:41:51 -0400

emacs-goodies-el (21.0-1) unstable; urgency=low

  * Rename whitespace to nuke-trailing-whitespace.el (closes: #191527)
  * Added file debian-bts-control.el to dpkg-dev-el.
  * Add `add-hook' expression to 50emacs-goodies-el.el to setup wdired to
    "r" key in dired-mode, since it can't really hurt anyway.
    (closes: #156830)
  * Update apt-sources.el to V0.9.7.
  * Updated all.el to 5.2 (1997/03/04) from
    ftp://ftp.dina.kvl.dk:/pub/Staff/Per.Abrahamsen/auctex/all.el
  * Updated auto-fill-inhibit.el to latest upstream version (defcustom
    patch that I submitted).
  * Updated htmlize.el to V0.68. Remove 5_htmlize-noninteractive.dpatch
    since it was integrated upstream.
  * Added elisp/emacs-goodies-el.texi and install it in rules file.
    (closes: #192303)
  * 50emacs-goodies-el.el: Introduce defcustom group emacs-goodies-el to
    allow full installation of packages that alter Emacs defaults.
    (closes: #190177)
  * Added debian-copyright.el CVS 1.6 from devscripts-el-0.0.20030512.tar.gz
    to dpkg-dev-el.
  * debian-changelog-mode: check if `debian-changelog-mode' is available
    as a feature, and not simply the if the autoloaded are fboundp (which
    is always true)  (closes: #193085).

 -- Peter S Galbraith   Mon, 12 May 2003 20:33:15 -0400

emacs-goodies-el (20.0-1) unstable; urgency=low

  * Make sure I include patches in debian diff.  The last upload was built
    without applying them! (closes: #191763)
  * Added apt-utils.el to emacs-goodies-el package (closes: #169726)

 -- Peter S Galbraith   Mon,  5 May 2003 20:59:17 -0400

emacs-goodies-el (19.5-1) unstable; urgency=low

  * debian-changelog-mode.el: defcustom added for debian-changelog-mode-hook
   (closes: #190853).
  * debian-bug.el: new upstream version.
  * debian-changelog-mode.el: debian-changelog-add-version creates new
    version in empty file (closes: #191285).
  * xrdb-mode.el: New upstream version added font-lock-defaults for Emacs
    (closes: #166874)
  * No longer depend on emacsen-common, which forced it's very verbose
    byte-compilation.  Also output byte-compilation verbiage to a tempfile.
    (closes: #185703)

 -- Peter S Galbraith   Wed, 30 Apr 2003 22:40:40 -0400

emacs-goodies-el (19.4-1) unstable; urgency=low

  * debian-bug.el: Revert `send bug report to maintonly if priority wishlist or
    minor change'.
  * debian-bug.el: New buffer-local variable `debian-bug-open-alist' for
    open bugs.  New actions in Bugs list menu: can now read bug reports
    as Email!
  * debian-changelog-mode.el: Use `debian-bug-open-alist'.
  * debian/control: dpkg-dev-el depends on debbugs-el (>= 19.4-1) for
    `debian-bug-open-alist' and Email reading.
  * debian-bug.el: Use executable-find.  Patch contributed by Romain FRANCOISE
     (closes: #189605).
  * debian-bug.el (debian-bug): always build package list (closes: #186338)
  * ff-paths.el: updated to V3.19
  * debian/emacsen-install.template: Use --no-site-file during
    installation byte-compilation.

 -- Peter S Galbraith   Tue, 22 Apr 2003 12:53:01 -0400

emacs-goodies-el (19.3-1) unstable; urgency=low

  * New upstream release for ff-paths.el (V3.18).
  * Add Uploaders field for Peter Galbraith.
  * debian-bug.el: send bug report to maintonly if priority wishlist or
    minor (closes: #176429)

 -- Peter S Galbraith   Fri, 11 Apr 2003 21:05:43 -0400

emacs-goodies-el (19.2-1) unstable; urgency=low

  * New upstream release for debian-bug.el (1.35) (closes: #173040,
    #184954).

 -- Roland Mas   Fri, 28 Mar 2003 13:19:47 +0100

emacs-goodies-el (19.1-1) unstable; urgency=low

  * New upstream release for debian-bug.el (1.35).

 -- Roland Mas   Wed, 19 Mar 2003 22:33:55 +0100

emacs-goodies-el (19-3) unstable; urgency=low

  * Patch #7_devscripts-debuild-uc-us: the arguments to debuild need to be
    in separate strings (closes: #185154) (yes, again).

 -- Roland Mas   Wed, 19 Mar 2003 22:05:10 +0100

emacs-goodies-el (19-2) unstable; urgency=low

  * Patch #5_htmlize-noninteractive: fix htmlize.el in non-interactive
    mode thanks to Junichi Uekawa's patch (closes: #166587).
  * Patch #6_readme-debian: fix readme-debian.el failing to load some
    README.Debian files thanks to James LewisMoss's patch (closes:
    #167575).
  * Favor reportbug over bug (closes: #184020).
  * Patch #4_dict-pager: invoke with appropriate pager options (closes:
    #174661).
  * Patch #7_devscripts-debuild-uc-us: invoke debuild with "-uc -us"
    parameters, so as not to ask for a passphrase (closes: #185154).

 -- Roland Mas   Wed, 19 Mar 2003 15:28:25 +0100

emacs-goodies-el (19-1) unstable; urgency=low

  * Now using dpatch to apply patches at build time.  Much better than the
    previous hand-made system.
  * Patch #4_dict-pager: dict.el patched to invoke dict with --pager
    (closes: #174661).
  * Removed nnmaildir.el, now included in Gnus (closes: #154396).

 -- Roland Mas   Wed, 19 Feb 2003 13:46:08 +0100

emacs-goodies-el (18.2-1) unstable; urgency=low

  * Fix autoload for dict.el (closes: #173143).
  * Made README.Debian more explicit: it documents all files, not just the
    ones in emacs-goodies-el (closes: #172335).
  * New upstream release for debian-bug.el (1.34) (closes: #168811).
  * Bumped Standards-Version to 3.5.8.

 -- Roland Mas   Tue, 17 Dec 2002 19:30:10 +0100

emacs-goodies-el (18.1-2) unstable; urgency=low

  * Changing sections to resolve override disparity.
  * Explicitly use the Bash shebang, since the installation scripts use
    bashisms (closes: #166310).
  * Fix load-path for dpkg-dev-el (closes: #166586).

 -- Roland Mas   Tue, 12 Nov 2002 20:05:48 +0100

emacs-goodies-el (18.1-1) unstable; urgency=low

  * New upstream release for thinks.el (1.8).
  * New upstream release for debian-changelog-mode.el (1.66) adds new
    distribution (closes: #166163).

 -- Roland Mas   Thu, 24 Oct 2002 18:34:22 +0200

emacs-goodies-el (18-1) unstable; urgency=low

  * New binary package: devscripts-el.  It currently includes
    devscripts.el and readme-debian.el, both at version 0.0.20021016.
  * Also changed the build process a bit: *.emacsen-install and
    *.emacsen-remove files are now built from *.in files.  Since most of
    the files are identical save for the package name and a few other
    variables at the beginning, let's put that shared code into a separate
    unique file.
  * Added sys-apropos.el (no version, taken at 2002-10-17).
  * New packages merged in: debbugs-el and dpkg-dev-el.  That should be
    all for now.  The previous changelogs are included at the bottom of
    this file.  Search for "8-merged-debbugs-el" or "3-merged-dpkg-dev-el"
    to get to their beginnings.

 -- Roland Mas   Sun, 20 Oct 2002 15:12:37 +0200

emacs-goodies-el (17-1) unstable; urgency=low

  * Merged the emacs-goodies-el and gnus-bonus-el source packages into one
    (named emacs-goodies-el).
  * The changelog of what happened to the gnus-goodies-el package before
    this merger happened is kept for reference at the bottom of this
    changelog file.  Search for the "4-merged-gnus-bonus-el" string to get
    to its beginning.
  * While I was at it, I created a new package, emacs-goodies-extra-el, so
    that interesting files with extra dependencies can still be included.
    Beware, this package is likely to have a growing list of dependencies.
    But that also means that I'm going to start accepting files with
    external dependencies into this source package (under the condition
    that they be available as Debian packages in the "main" section).
  * emacs-goodies-extra-el: added dict.el (1.25).

 -- Roland Mas   Mon, 14 Oct 2002 21:17:10 +0200

emacs-goodies-el (16.1-1) unstable; urgency=low

  * New upstream release for boxquote.el (1.16) (closes: #163834).
  * New upstream release for wdired.el (1.9.2pre2) (closes: #161157).
  * Fixed the auto-mode for xrdb-mode.el (closes: #161563).

 -- Roland Mas   Wed,  9 Oct 2002 13:55:22 +0200

emacs-goodies-el (16-1) unstable; urgency=low

  * Added home-end.el (2002-07-12) (closes: #152725), with proposed
    patch.
  * Added xrdb-mode.el (2.28) (closes: #154039).
  * Added map-lines.el (0.1).
  * Also cleaned up the patching system a bit.

 -- Roland Mas   Fri, 13 Sep 2002 17:05:51 +0200

emacs-goodies-el (15.1-1) unstable; urgency=low

  * Bumped Standards-Version to 3.5.7.
  * Sorted the list of files in the package description (closes: #160017).
  * New upstream release for muttrc-mode.el (2.5).
  * Started using a (very) light patching system.  First patch is
    500muttrc-manual, so that the file that muttrc-mode.el opens actually
    exists (closes: #158571).
  * Also cleaned debian/rules a bit.

 -- Roland Mas   Mon,  9 Sep 2002 19:40:19 +0200

emacs-goodies-el (15-1) unstable; urgency=low

  * Added muttrc-mode.el (2.4) (closes: #146780).
  * Added ibuffer.el (2.6) (closes: #134086).
  * Fixed emacsen-install script again (closes: #158480).

 -- Roland Mas   Tue, 27 Aug 2002 20:19:24 +0200

emacs-goodies-el (14-2) unstable; urgency=low

  * Depend on a recent bash, since we use features not available in old
    ones.
  * Also fixed the emacs-goodies-el.emacsen-install script so that it
    won't forget files that are excluded in other flavours than the
    current one (closes: #149921).

 -- Roland Mas   Mon, 26 Aug 2002 13:46:01 +0200

emacs-goodies-el (14-1) unstable; urgency=low

  * The "Elmo owes me one" release.
  * Added apt-sources.el (0.9.5).

 -- Roland Mas   Wed, 21 Aug 2002 13:37:56 +0200

emacs-goodies-el (13-1) unstable; urgency=low

  * Added tc.el (0.12.3) (closes: #122243).
  * New upstream release for keywiz.el (1.2).
  * New upstream release for browse-kill-ring.el (1.0).
  * New upstream release for boxquote.el (1.8).

 -- Roland Mas   Thu,  2 May 2002 14:01:00 +0200

emacs-goodies-el (12.1-1) unstable; urgency=low

  * New upstream release for boxquote.el (1.7).

 -- Roland Mas   Fri, 19 Apr 2002 19:07:15 +0200

emacs-goodies-el (12-1) unstable; urgency=low

  * Added keywiz.el (1.1) (closes: #143072).
  * Added table.el (1.5.48) (closes: #124119).

 -- Roland Mas   Fri, 19 Apr 2002 18:53:54 +0200

emacs-goodies-el (11-2) unstable; urgency=low

  * Excluded todoo.el from Xemacs 21.

 -- Roland Mas   Wed, 17 Apr 2002 14:00:29 +0200

emacs-goodies-el (11-1) unstable; urgency=low

  * Added all.el (0.0), toggle-option.el (1.0), todoo.el (1.2),
    cyclebuffer.el (1.2).

 -- Roland Mas   Tue, 16 Apr 2002 19:33:07 +0200

emacs-goodies-el (10-3) unstable; urgency=low

  * Fixed emacsen-install script (closes: #134778).  It's a bashism, but
    I'm too lazy to POSIXise it (I'm not even sure it can be POSIXised),
    so I just change the shebang.

 -- Roland Mas   Thu, 21 Feb 2002 18:47:25 +0100

emacs-goodies-el (10-2) unstable; urgency=low

  * Fixed README.Debian to mention the problem with Emacs 21 and
    whitespace.el.

 -- Roland Mas   Mon, 18 Feb 2002 13:12:38 +0100

emacs-goodies-el (10-1) unstable; urgency=low

  * Added ff-paths.el (3.17), dirvars.el (1.0), perldoc.el (1.1).
  * Patched emacsen-install to support flavor-dependent lists of files to
    include/exclude.
  * Use debian-pkg-add-load-path-item if available.
  * Renamed (with wdired and rect ;-) the debian/emacsen-* files into
    debian/emacs-goodies-el.emacsen-*.  Because I can, and also because of
    a Secret Plan I have.
  * Disabled whitespace.el for Emacs 21 (closes: #133014).  I'd like to
    find a better solution fot this, but I haven't thought of it yet.

 -- Roland Mas   Mon, 18 Feb 2002 12:55:51 +0100

emacs-goodies-el (9-1) unstable; urgency=low

  * Added highlight-current-line.el (0.5), align-string.el (0.1) (closes:
    #113283), diminish.el (0.44), htmlize.el (0.62) and keydef.el (1.16).

 -- Roland Mas   Fri,  4 Jan 2002 21:10:06 +0100

emacs-goodies-el (8-2) unstable; urgency=low

  * Fixed speling error in Description: field (closes: #124598).

 -- Roland Mas   Tue, 18 Dec 2001 10:11:42 +0100

emacs-goodies-el (8-1) unstable; urgency=low

  * Added under.el (1.2).

 -- Roland Mas   Fri,  7 Dec 2001 22:50:20 +0100

emacs-goodies-el (7.1-1) unstable; urgency=low

  * New upstream release for egocentric.el (1.1).
  * New upstream release for df.el (1.8) (closes: #122805).

 -- Roland Mas   Fri,  7 Dec 2001 21:48:22 +0100

emacs-goodies-el (7-1) unstable; urgency=low

  * Added toggle-case.el (1.4), tail.el (1.1), df.el (1.7), egocentric.el
    (not versioned, taken on 2001-12-04) and initsplit.el (1.6).

 -- Roland Mas   Wed,  5 Dec 2001 22:44:17 +0100

emacs-goodies-el (6-2) unstable; urgency=low

  * Fixed README.Debian to document the recent apparition of
    highlight-beyond-fill-column.el.

 -- Roland Mas   Thu, 29 Nov 2001 21:54:30 +0100

emacs-goodies-el (6-1) unstable; urgency=low

  * Added highlight-beyond-fill-column.el (1.1).

 -- Roland Mas   Wed, 21 Nov 2001 22:55:35 +0100

emacs-goodies-el (5.1-1) unstable; urgency=low

  * New upstream release for wdired.el (1.91).

 -- Roland Mas   Mon, 19 Nov 2001 14:44:35 +0100

emacs-goodies-el (5-1) unstable; urgency=low

  * Added wdired.el (1.9), floatbg.el (0.5), clipper.el (1.1.0),
    projects.el, auto-fill-inhibit.el (20011114).

 -- Roland Mas   Sat, 17 Nov 2001 17:33:49 +0100

emacs-goodies-el (4-3) unstable; urgency=low

  * debian/emacsen-startup: fix typo (closes: #116855).

 -- Roland Mas   Wed, 24 Oct 2001 09:19:17 +0200

emacs-goodies-el (4-2) unstable; urgency=low

  * debian/control: changed Description: field to reflect the recent
    additions.

 -- Roland Mas   Mon, 22 Oct 2001 11:33:32 +0200

emacs-goodies-el (4-1) unstable; urgency=low

  * Added filladapt.el (2.12) (closes: #111383), setnu.el (1.06).
  * debian/control: changed Build-Depends: to Build-Depends-Indep:.

 -- Roland Mas   Sun, 21 Oct 2001 16:15:15 +0200

emacs-goodies-el (3.1-2) unstable; urgency=low

  * Changed debian/control formatting (closes: #110053).

 -- Roland Mas   Sun,  9 Sep 2001 18:34:21 +0200

emacs-goodies-el (3.1-1) unstable; urgency=low

  * Upgraded browse-kill-ring.el to 0.9.

 -- Roland Mas   Mon, 27 Aug 2001 18:53:32 +0200

emacs-goodies-el (3-1) unstable; urgency=low

  * Added browse-kill-ring.el (0.8), coffee.el (0.2), twiddle.el (1.3),
    whitespace.el (1.9), silly-mail.el (1.22), obfusurl.el (1.5),
    toggle-buffer.el (1.1), mutt-alias.el (1.2), protbuf.el (1.7).

 -- Roland Mas   Fri, 24 Aug 2001 18:10:38 +0200

emacs-goodies-el (2.0-2) unstable; urgency=low

  * Fixed package description in the control file.

 -- Roland Mas   Thu, 23 Aug 2001 17:27:02 +0200

emacs-goodies-el (2.0-1) unstable; urgency=low

  * Added bar-cursor.el (1.1), tld.el (1.3), services.el (1.2),
    protocols.el (1.3) and highlight-completion.el (0.06).

 -- Roland Mas   Thu, 23 Aug 2001 12:27:51 +0200

emacs-goodies-el (1.0-1) unstable; urgency=low

  * Initial Release.
  * Contents: boxquote.el (1.6) and thinks.el (1.6).

 -- Roland Mas   Tue, 21 Aug 2001 22:09:45 +0200

gnus-bonus-el (4-merged-gnus-bonus-el) unstable; urgency=low

  * This is the version that never happened.  The gnus-bonus-el source
    package was merged into emacs-goodies version 17.  They still generate
    different binary packages, though.  The following changelog entries
    (down there in this file) are only here for reference.

 -- Roland Mas   Sun, 13 Oct 2002 23:17:45 +0200

gnus-bonus-el (3.1-1) unstable; urgency=low

  * New upstream version for spam-stat.el (0.1.0).
  * Bumped Standards-Version to 3.5.7.

 -- Roland Mas   Fri,  6 Sep 2002 18:31:21 +0200

gnus-bonus-el (3-1) unstable; urgency=low

  * Added spam-stat.el (0.0.4) and gnus-outlook-deuglify.el (1.2).

 -- Roland Mas   Mon, 26 Aug 2002 22:51:50 +0200

gnus-bonus-el (2-3) unstable; urgency=low

  * Applied patch from Michael Hummel  to fix nnir.el
    with respect to swish++ (closes: #133278).

 -- Roland Mas   Thu,  7 Mar 2002 13:12:21 +0100

gnus-bonus-el (2-2) unstable; urgency=low

  * Changed Depends: field so that the gnus package is not required (since
    Gnus is included in the emacs21, emacs20 and xemacs21 packages)
    (closes: #127792).

 -- Roland Mas   Fri,  4 Jan 2002 18:28:49 +0100

gnus-bonus-el (2-1) unstable; urgency=low

  * Added nnir.el (1.73), nnmaildir.el (2001.09.11).

 -- Roland Mas   Sat, 15 Dec 2001 21:01:50 +0100

gnus-bonus-el (1-1) unstable; urgency=low

  * Initial Release.
  * Contents: gnus-junk.el (0.23), nnnil.el (not versioned, taken at
    2001-12-04), nntodo.el (1.1), mesage-x.el (1.23).

 -- Roland Mas   Tue,  4 Dec 2001 14:17:50 +0100

debbugs-el (8-merged-debbugs-el) unstable; urgency=low

  * This is the version that never happened.  The debbugs-el source
    package was merged into emacs-goodies-el version 18.  They still
    generate different binary packages, though.  The following changelog
    entries (down there in this file) are only here for reference.

 -- Roland Mas   Sun, 20 Oct 2002 15:11:56 +0200

debbugs-el (7.12-1) unstable; urgency=low

  * New upstream version for debian-bug.el (1.33) allows the menus to be
    split according to severity (closes: #161155).
  * Bumped DH_COMPAT to 4.

 -- Roland Mas   Wed,  2 Oct 2002 13:50:53 +0200

debbugs-el (7.11-1) unstable; urgency=low

  * New upstream version for debian-bug.el (1.32) fixes several bugs
    (closes: #159625, #160750).

 -- Roland Mas   Fri, 13 Sep 2002 17:14:19 +0200

debbugs-el (7.10-4) unstable; urgency=low

  * Fixed the fix in 7.10-3.  The flavour-independent component is needed,
    only I have to make it lower priority than the flavour-dependent
    component (closes: #159624).
  * Versioned Depends: on emacsen-common, so that we can get rid of the
    old compatibility code in the emacsen-startup file.
  * Bumped Standards-Version to 3.5.7.

 -- Roland Mas   Mon,  9 Sep 2002 13:32:55 +0200

debbugs-el (7.10-3) unstable; urgency=low

  * Fixed the load-path fiddling, so that the byte-compiled *.elc files
    are used instead of the non-compiled *.el files (closes: #159624).

 -- Roland Mas   Fri,  6 Sep 2002 13:38:03 +0200

debbugs-el (7.10-2) unstable; urgency=low

  * Force compression of the compilation log, to allow for non-interactive
    installation (closes: #157798).

 -- Roland Mas   Thu, 22 Aug 2002 12:48:42 +0200

debbugs-el (7.10-1) unstable; urgency=low

  * New upstream release for debian-bug.el (1.31) fixes several bugs
    (closes: #117036, #156297, #156391).

 -- Roland Mas   Tue, 20 Aug 2002 14:27:41 +0200

debbugs-el (7.9-1) unstable; urgency=low

  * New upstream release for debian-bug.el (1.27) (closes: #151717).
  * Slightly patched gnus-BTS.el to allow other Elisp programs to
    "require" it (closes: #151718).

 -- Roland Mas   Fri, 12 Jul 2002 12:20:10 +0200

debbugs-el (7.8-3) unstable; urgency=low

  * Cosmetic changes to installation (closes: #124056).

 -- Roland Mas   Tue,  9 Apr 2002 14:25:55 +0200

debbugs-el (7.8-2) unstable; urgency=low

  * Changed the way I call debian-pkg-add-load-path-item, since it doesn't
    change the contents of the load-path variable as I thought it did
    (closes: #134392).

 -- Roland Mas   Sun, 17 Feb 2002 21:22:03 +0100

debbugs-el (7.8-1) unstable; urgency=low

  * New upstream release for debian-bug.el (1.26).
  * Use debian-pkg-add-load-path-item if available.
  * Wrapped the .emacsen-startup file into a test for the installedness of
    the package, to prevent nasty stuff from happening when the package is
    uninstalled but not purged (closes: #134096).

 -- Roland Mas   Fri, 15 Feb 2002 21:26:18 +0100

debbugs-el (7.7-1) unstable; urgency=low

  * New upstream release for debian-bug.el (1.23).
  * This release uses a new feature of reportbug, hence the versioned
    Depends: field.  (closes: #122032).

 -- Roland Mas   Fri, 14 Dec 2001 13:58:38 +0100

debbugs-el (7.6-1) unstable; urgency=low

  * New upstream release for debian-bug.el (1.22) (closes: #122033,
    #121932, #123476).
  * Also fixed the autoload docstring for #121932.

 -- Roland Mas   Wed, 12 Dec 2001 12:22:25 +0100

debbugs-el (7.5-1) unstable; urgency=low

  * New upstream release for debian-bug.el (1.19) (closes: #117976,
    #117855, #117842).

 -- Roland Mas   Thu,  8 Nov 2001 18:50:03 +0100

debbugs-el (7.4-1) unstable; urgency=low

  * ACK NMU by Peter (closes: #111615).
  * New upstream version for debian-bug.el (1.17) (closes: #111332).

 -- Roland Mas   Sun, 21 Oct 2001 14:32:01 +0200

debbugs-el (7.3-1) unstable; urgency=low

  * NMU by debian-bug.el upstream maintainer (Roland is on vacation).
  * New upstream release for debian-bug.el (1.16).
  - Includes template for ITP/RPC bugs lifted from reportbug (closes: #111615).
  - Work around bug #111331 (function font-lock-add-keywords doesn't exist
    in XEmacs) temporarily.  There's no fontification in XEmacs, but at
    least the code loads.  I'll close the bug when it's actually fixed.

 -- Peter S Galbraith   Fri, 21 Sep 2001 16:18:07 -0400

debbugs-el (7.2-2) unstable; urgency=low

  * Removed version numbers from package description.

 -- Roland Mas   Thu, 16 Aug 2001 16:46:02 +0200

debbugs-el (7.2-1) unstable; urgency=low

  * New upstream release for debian-bug.el (1.15).
  * 1.14 release also increased consistency in function naming scheme
    (closes: #108808).
  * Now Recommends: wget.

 -- Roland Mas   Thu, 16 Aug 2001 11:43:45 +0200

debbugs-el (7.1-1) unstable; urgency=low

  * New upstream release for debian-bug.el (1.13).
  * Changed Depends: line (closes: #108804).

 -- Roland Mas   Wed, 15 Aug 2001 18:56:01 +0200

debbugs-el (7.0-1) unstable; urgency=low

  * Changed numbering scheme: major will change when adding or removing
    files to this package; minor will change when these files have a new
    upstream release; Debian revision is for packaging only.
  * deban-bug.el: new upstream release 1.12 (new upstream maintainer is
    Peter S Galbraith ).
  * Added autoloads for debian-bug.el.

 -- Roland Mas   Wed, 15 Aug 2001 09:41:50 +0200

debbugs-el (6) unstable; urgency=low

  * gnus-BTS.el: made the regexps that recognise a Debian group a bit more
    permissive.
  * debian-bug.el: mark the bug reporting buffer as non-modified after
    initialisation (Toby Speight ) (closes: #95372).

 -- Roland Mas   Fri, 27 Apr 2001 18:07:05 +0200

debbugs-el (5) unstable; urgency=low

  * Fixed load-path problem for gnus-BTS.el (closes: #93334).

 -- Roland Mas   Sat, 21 Apr 2001 17:12:56 +0200

debbugs-el (4) unstable; urgency=low

  * Removed compilation of gnus-BTS.el to avoid undefined problems with
    undefined macros. (closes: #89838)

 -- Roland Mas   Fri, 30 Mar 2001 18:36:00 +0200

debbugs-el (3) unstable; urgency=low

  * Added Depends: bug to control file (closes: #89357)

 -- Roland Mas   Mon, 12 Mar 2001 20:20:35 +0100

debbugs-el (2) unstable; urgency=low

  * New upstream release for gnus-BTS.el: copyright assignment is changed,
    Xemacs dependency is dead, more BTS keywords, regex cleanup,
    etc. (closes: #88294).

 -- Roland Mas   Sun, 11 Mar 2001 19:27:16 +0100

debbugs-el (1) unstable; urgency=low

  * Initial Release.
  * Includes debian-bug.el and gnus-BTS.el (closes: #85883, #85974).

 -- Roland Mas   Tue, 27 Feb 2001 20:57:06 +0100

dpkg-dev-el (3-merged-dpkg-dev-el) unstable; urgency=low

  * This is the version that never happened.  The dpkg-dev-el source
    package was merged into emacs-goodies-el version 18.  They still
    generate different binary packages, though.  The following changelog
    entries (down there in this file) are only here for reference.

 -- Roland Mas   Sun, 20 Oct 2002 15:11:56 +0200

dpkg-dev-el (2.9-1) unstable; urgency=low

  * New upstream version for debian-changelog-mode.el (1.65).
  * Bumped Standards-Version to 3.5.7.

 -- Roland Mas   Fri,  6 Sep 2002 16:24:28 +0200

dpkg-dev-el (2.8-1) unstable; urgency=low

  * New upstream version for debian-changelog-mode.el (1.64), fixes
    several bugs (closes: #159041, #159643).

 -- Roland Mas   Fri,  6 Sep 2002 08:56:29 +0200

dpkg-dev-el (2.7-2) unstable; urgency=low

  * Changed the load-path used at install time, to fix installation
    problem on Xemacs (closes: #157811).

 -- Roland Mas   Thu, 22 Aug 2002 15:38:07 +0200

dpkg-dev-el (2.7-1) unstable; urgency=low

  * Now depends on debbugs-el.
  * New upstream version for debian-changelog-mode.el (1.62) fixes several
    bugs (closes: #113964, #156762).

 -- Roland Mas   Wed, 21 Aug 2002 09:33:27 +0200

dpkg-dev-el (2.6-1) unstable; urgency=low

  * New upstream release for debian-changelog-mode.el (1.57) (closes: #154747).

 -- Roland Mas   Tue, 30 Jul 2002 08:40:12 +0200

dpkg-dev-el (2.5-1) unstable; urgency=low

  * New upstream release for debian-changelog-mode.el (1.56) (closes: #153982).

 -- Roland Mas   Thu, 25 Jul 2002 17:09:15 +0200

dpkg-dev-el (2.4-1) unstable; urgency=low

  * The "Yeah, I know I'm late" release.
  * Acknowledging the NMU.  Thanks, Colin.
  * New upstream release for debian-changelog-mode.el (1.55) (closes: #146583)

 -- Roland Mas   Mon, 15 Jul 2002 13:57:45 +0200

dpkg-dev-el (2.3-1) unstable; urgency=medium

  * NMU
  * New upstream release for debian-control-mode.el (0.4).

 -- Colin Walters   Fri, 31 May 2002 16:15:50 -0400

dpkg-dev-el (2.2-2) unstable; urgency=low

  * Changed the way I call debian-pkg-add-load-path-item, since it doesn't
    change the contents of the load-path variable as I thought it did.

 -- Roland Mas   Sun, 17 Feb 2002 21:51:29 +0100

dpkg-dev-el (2.2-1) unstable; urgency=low

  * New upstream release for debian-control-mode.el (0.3).
  * New upstream release for debian-changelog-mode (1.52).
  * Use debian-pkg-add-load-path-item if available.

 -- Roland Mas   Tue, 12 Feb 2002 22:53:20 +0100

dpkg-dev-el (2.1-1) unstable; urgency=low

  * New upstream (bugfix) release for debian-control-mode.el (0.2).

 -- Roland Mas   Mon,  3 Dec 2001 13:51:48 +0100

dpkg-dev-el (2-1) unstable; urgency=low

  * Added debian-control-mode.el (0.1) (closes: #121690).  Cool, that
    means I was right in calling the package dpkg-dev-el and not just
    debian-changelog-mode-el.
  * Changed numbering scheme, see README.Debian.
  * Also added magic in emacsen-startup so that emacsen-startup files load
    in Emacs Lisp mode, as they should, and no more in Fundamental mode.
  * New upstream release for debian-changelog-mode.el (1.50).

 -- Roland Mas   Fri, 30 Nov 2001 11:00:25 +0100

dpkg-dev-el (1.49-1) unstable; urgency=low

  * New upstream release.
  * Fiddled with debian/control a bit.

 -- Roland Mas   Thu, 22 Nov 2001 19:01:24 +0100

dpkg-dev-el (1.48-1) unstable; urgency=low

  * NMU by upstream author (Roland is on vacation).
  * New upstream release.

 -- Peter S Galbraith   Wed, 19 Sep 2001 11:38:59 -0400

dpkg-dev-el (1.47-2) unstable; urgency=low

  * Added the appropriate load-path (closes: #111702).

 -- Roland Mas   Sun,  9 Sep 2001 18:36:53 +0200

dpkg-dev-el (1.47-1) unstable; urgency=low

  * New upstream release.

 -- Roland Mas   Wed, 15 Aug 2001 21:02:43 +0200

dpkg-dev-el (1.46-1) unstable; urgency=low

  * New upstream release.
  * Fix font-lock code (closes: #108809).
  * New feature requires a Recommends: wget.

 -- Roland Mas   Wed, 15 Aug 2001 19:38:04 +0200

dpkg-dev-el (1.44-2) unstable; urgency=low

  * Minor copyright tweaks.

 -- Roland Mas   Sun,  5 Aug 2001 17:49:37 +0200

dpkg-dev-el (1.44-1) unstable; urgency=low

  * New upstream release.
  * Added autoloads for the debian-changelog-web-* functions (except for
    d-c-w-this-bug-under-mouse).

 -- Roland Mas   Fri, 27 Jul 2001 18:55:48 +0200

dpkg-dev-el (1.43-1) unstable; urgency=low

  * New upstream release.
  * Updated to policy 3.5.6.0.
  * Added hook to find-file-hooks to switch to debian-changelog-mode for
    files that look like some Debian changelog, even if that can't be
    decided from the file name (closes: #105889).

 -- Roland Mas   Thu, 26 Jul 2001 10:00:35 +0200

dpkg-dev-el (1.42-1) unstable; urgency=low

  * New upstream release (closes: #102088).

 -- Roland Mas   Thu, 12 Jul 2001 13:39:08 +0200

dpkg-dev-el (1.40-1) unstable; urgency=low

  * New upstream release.

 -- Roland Mas   Wed, 27 Jun 2001 09:49:22 +0200

dpkg-dev-el (1.39-1) unstable; urgency=low

  * New upstream release (closes: #100639).

 -- Roland Mas   Fri, 15 Jun 2001 09:51:39 +0200

dpkg-dev-el (1.37-1) unstable; urgency=low

  * New upstream release (closes: #100162).

 -- Roland Mas   Tue, 12 Jun 2001 09:45:11 +0200

dpkg-dev-el (1.34-1) unstable; urgency=low

  * New upstream release (closes: #99051).

 -- Roland Mas   Tue, 29 May 2001 18:08:43 +0200

dpkg-dev-el (1.33-1) unstable; urgency=low

  * New upstream release.  Should fix problems with Xemacs.  Yes, again.

 -- Roland Mas   Tue, 29 May 2001 15:53:59 +0200

dpkg-dev-el (1.32-1) unstable; urgency=low

  * New upstream release.  Should fix problems with Xemacs.
  * The "Not another shrubbery!" release.

 -- Roland Mas   Tue, 29 May 2001 09:30:56 +0200

dpkg-dev-el (1.31-1) unstable; urgency=low

  * New upstream release (closes: #98577).

 -- Roland Mas   Mon, 28 May 2001 19:00:36 +0200

dpkg-dev-el (1.30-1) unstable; urgency=low

  * New upstream release.
  * Default to the same distribution as the previous release, as requested
    (closes: #96260).

 -- Roland Mas   Wed,  9 May 2001 21:47:05 +0200

dpkg-dev-el (1.24-1) unstable; urgency=low

  * New upstream release.
  * The "I'm going to start a strike" release.

 -- Roland Mas   Thu,  3 May 2001 19:20:17 +0200

dpkg-dev-el (1.23-1) unstable; urgency=low

  * New upstream release.
  * The "there, see what happens?" release.

 -- Roland Mas   Thu,  3 May 2001 13:00:06 +0200

dpkg-dev-el (1.22-1) unstable; urgency=low

  * The "would someone please slow him down?" release.
  * New upstream release.  Yes, *again* :-)

 -- Roland Mas   Wed,  2 May 2001 19:34:05 +0200

dpkg-dev-el (1.19-1) unstable; urgency=low

  * New upstream releases seem to pop up faster than I can track them.
    This one is 1.19 (closes: #95831).
  * Fix the startup script (yes, again) (closes: #95830).

 -- Roland Mas   Wed,  2 May 2001 14:08:01 +0200

dpkg-dev-el (1.13-1) unstable; urgency=low

  * New upstream release.
  * Less flashy colouring (closes: #93243).
  * Less verbosity during byte-compilation (closes: #95347).
  * Some fixes in the startup script (closes: #95348).

 -- Roland Mas   Fri, 27 Apr 2001 20:12:57 +0200

dpkg-dev-el (1.10-1) unstable; urgency=low

  * New upstream release.
  * Fix number suggestion scheme (closes: #88245, #88589).
  * add-log-mailing-address is now (since 1.06 in fact)
    debian-changelog-mailing-address (closes: #89208).

 -- Roland Mas   Sun, 11 Mar 2001 18:33:11 +0100

dpkg-dev-el (1.07-1) unstable; urgency=low

  * New upstream release.
  * Handle epochs correctly (closes: #87964).
  * Make lintian happy.

 -- Roland Mas   Wed, 28 Feb 2001 17:24:38 +0100

dpkg-dev-el (1.05-1) unstable; urgency=low

  * New upstream release.  Closes: #85412.

 -- Roland Mas   Mon, 26 Feb 2001 09:38:34 +0100

dpkg-dev-el (1.01-4) unstable; urgency=low

  * Changed Description: field again (Closes: #85413).

 -- Roland Mas   Sat, 10 Feb 2001 14:19:34 +0100

dpkg-dev-el (1.01-3) unstable; urgency=low

  * Changed Description: field and maintainer address.

 -- Roland Mas   Wed, 24 Jan 2001 12:55:53 +0100

dpkg-dev-el (1.01-2) unstable; urgency=low

  * Changed Depends: to Suggests:

 -- Roland Mas <99.roland.mas@aist.enst.fr>  Tue,  9 Jan 2001 09:54:34 +0100

dpkg-dev-el (1.01-1) unstable; urgency=low

  * Initial Release.

 -- Roland Mas <99.roland.mas@aist.enst.fr>  Fri, 22 Dec 2000 14:09:40 +0100
emacs-goodies-el-35.8ubuntu2/debian/debbugs-el.copyright0000775000000000000000000000034212230377266020202 0ustar  The package debbugs-el has been renamed debian-el.

This package ensures that debian-el is installed during upgrades and
should thereafter be removed.

The contents are in the public domain.
Peter S Galbraith 
emacs-goodies-el-35.8ubuntu2/debian/patches/0000775000000000000000000000000012230377267015665 5ustar  emacs-goodies-el-35.8ubuntu2/debian/patches/51_todoo_bug267637.diff0000775000000000000000000000402412230377266021506 0ustar  #!/bin/sh -e
## 51_todoo_bug267637.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/todoo.el emacs-goodies-el/elisp/emacs-goodies-el/todoo.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/todoo.el	2004-11-25 21:51:26.000000000 -0500
+++ emacs-goodies-el/elisp/emacs-goodies-el/todoo.el	2004-11-25 21:56:39.000000000 -0500
@@ -57,6 +57,10 @@
 
 ;;; ChangeLog:
 
+;; 2004-11-24 Peter S Galbraith 
+;;  Debian bug 267637 fix: changes to outline-regexp should be buffer-local.
+;;  Thanks to Daniel Skarda <0rfelyus@hobitin.ucw.cz> for pointing it out.
+
 ;; 1.2 - Fixed bug in menu (todoo-show->todoo)
 ;;       Fixed bug when deleting window in todoo-save-and-exit
 ;;       Added early sub-item support (might be buggy, but still
@@ -512,10 +516,11 @@
   (make-local-variable 'font-lock-defaults)
   (setq font-lock-defaults '(todoo-font-lock-keywords t))
 
-  (setq outline-regexp (concat "^\\(" (regexp-quote todoo-item-marker) " \\|"
-			       (regexp-quote todoo-item-marker-assigned) 
-			       " \\|[ ]*" (regexp-quote todoo-sub-item-marker)
-			       " \\)"))
+  (set (make-local-variable 'outline-regexp)
+        (concat "^\\(" (regexp-quote todoo-item-marker) " \\|"
+                (regexp-quote todoo-item-marker-assigned) 
+                " \\|[ ]*" (regexp-quote todoo-sub-item-marker)
+                " \\)"))
 
   (outline-minor-mode 1)
 
emacs-goodies-el-35.8ubuntu2/debian/patches/50_gnus-filterhist.diff0000775000000000000000000000262312230377266022157 0ustar  #!/bin/sh -e
## 50_gnus-filterhist.dpatch by Jaakko Kangasharju 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Set font before turning buffer read-only (Fixes #331234)

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad ../emacs-goodies-el/elisp/gnus-bonus-el/gnus-filterhist.el emacs-goodies-el/elisp/gnus-bonus-el/gnus-filterhist.el
--- ../emacs-goodies-el/elisp/gnus-bonus-el/gnus-filterhist.el	2003-10-17 23:20:53.000000000 +0300
+++ emacs-goodies-el/elisp/gnus-bonus-el/gnus-filterhist.el	2005-10-13 20:59:18.000000000 +0300
@@ -188,9 +188,9 @@
 				)
 			    )))
 		      (setq nnmail-session-split-history my-session-split-history)
-		  ))))
-	(add-text-properties (point-min) (point-max)
-			     '(face gnus-filterhist-face-1))
+		  ))
+		(add-text-properties (point-min) (point-max)
+				     '(face gnus-filterhist-face-1))))
 	(switch-to-buffer buf)
 	(if gnus-filter-history-popup
 	    (pop-to-buffer "*Filter History*")
emacs-goodies-el-35.8ubuntu2/debian/patches/50_quack_autoload.diff0000664000000000000000000000612112230377266022016 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 50_quack_autoload.dpatch by Daniel Moerner 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Insert autoload headers for quack.el.

@DPATCH@
--- a/elisp/emacs-goodies-el/quack.el
+++ b/elisp/emacs-goodies-el/quack.el
@@ -62,9 +62,10 @@
 ;; INSTALLATION:
 ;;
 ;;     To install, put this file (`quack.el') somewhere in your Emacs load
-;;     path, and add the following line to your `.emacs' file:
+;;     path, and add the following lines to your `.emacs' file:
 ;;
 ;;         (require 'quack)
+;;         (quack-install)
 ;;
 ;;     If you don't know what your Emacs load path is, try invoking the command
 ;;     "C-h v load-path RET" or consulting the Emacs manual.
@@ -3159,6 +3160,8 @@
                              ;; Non-Scheme:
                              ("\\.plt\\'"    . quack-pltfile-mode)))
 
+;;;###autoload(add-to-list 'auto-mode-alist '("\\.plt\\'" . quack-pltfile-mode))
+
 ;; Syntax Table:
 
 (defmacro quack-str-syntax (str)
@@ -3508,10 +3511,6 @@
      (add-submenu nil quack-global-menuspec "Help" current-menubar)
      (set-menubar-dirty-flag))))
 
-;; TODO: We should make sure the user's custom settings have been loaded
-;; before we do this.
-(quack-install-global-menu)
-
 ;; And die some more!
 ;;(quack-when-xemacs (add-hook 'after-init-hook 'quack-install-global-menu))
 
@@ -4132,9 +4131,11 @@
   (quack-when-xemacs
    (quack-install-global-menu)))
 
+;;;###autoload
 (defun quack-inferior-scheme-mode-hookfunc ()
   (quack-shared-mode-hookfunc-stuff))
 
+;;;###autoload
 (defun quack-scheme-mode-hookfunc ()
   (quack-shared-mode-hookfunc-stuff)
 
@@ -4147,9 +4148,6 @@
   ;;(quack-install-tool-bar)))
   )
 
-(add-hook 'scheme-mode-hook          'quack-scheme-mode-hookfunc)
-(add-hook 'inferior-scheme-mode-hook 'quack-inferior-scheme-mode-hookfunc)
-
 ;; Compilation Mode:
 
 ;; TODO: Add compilation-directory-matcher support for "setup-plt:  in".
@@ -4215,8 +4213,6 @@
         (append quack-compilation-error-regexp-alist-additions
                 quack-saved-compilation-error-regexp-alist)))
 
-(quack-install-compilation-mode-stuff)
-
 ;; Interpreter-mode-alist:
 
 (defvar quack-saved-interpreter-mode-alist nil)
@@ -4256,8 +4252,6 @@
         (append quack-interpreter-mode-alist-additions
                 quack-saved-interpreter-mode-alist)))
 
-(quack-install-interpreter-mode-alist)
-
 ;; PLT Package Mode:
 
 ;; TODO: Do some simple checking and summarize what directories and files are
@@ -4285,6 +4279,7 @@
 
 ;; TODO: Make a menu map for pltfile-mode.
 
+;;;###autoload
 (defun quack-pltfile-mode ()
   (interactive)
   "Major mode for viewing PLT Scheme `.plt' package files.
@@ -4812,6 +4807,15 @@
 
 ;; End:
 
+;;;###autoload
+(defun quack-install ()
+  "Install quack.el into scheme-mode."
+  (add-hook 'scheme-mode-hook          'quack-scheme-mode-hookfunc)
+  (add-hook 'inferior-scheme-mode-hook 'quack-inferior-scheme-mode-hookfunc)
+  (quack-install-compilation-mode-stuff)
+  (quack-install-interpreter-mode-alist)
+  (quack-install-global-menu))
+
 (provide 'quack)
 
 ;; quack.el ends here
emacs-goodies-el-35.8ubuntu2/debian/patches/50_browse-kill-ring_bug224751.diff0000775000000000000000000000272612230377266023545 0ustar  #!/bin/sh -e
## 50_browse-kill-ring_bug224751.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/emacs-goodies-el/browse-kill-ring.el emacs-goodies-el/elisp/emacs-goodies-el/browse-kill-ring.el
--- emacs-goodies-el~/elisp/emacs-goodies-el/browse-kill-ring.el	2009-09-03 09:43:06.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/browse-kill-ring.el	2009-09-03 09:55:51.000000000 -0400
@@ -591,7 +591,10 @@
     (unwind-protect
 	(progn
 	  (setq buffer-read-only nil)
-	  (let ((target (overlay-get over 'browse-kill-ring-target)))
+	  (let ((target (overlay-get over 'browse-kill-ring-target))
+                ;; See http://bugs.debian.org/224751
+                ;; Emacs 21.1 fails when text was read-only
+                (inhibit-read-only t))
 	    (delete-region (overlay-start over)
 			   (1+ (overlay-end over)))
 	    (setq kill-ring (delete target kill-ring)))
emacs-goodies-el-35.8ubuntu2/debian/patches/50_diminish-defcustom.diff0000775000000000000000000001651612230377266022631 0ustar  #!/bin/sh -e
## 6_diminish-defcustom.dpatch.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/diminish.el emacs-goodies-el/elisp/emacs-goodies-el/diminish.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/diminish.el	2003-06-17 21:01:24.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/diminish.el	2003-06-18 19:51:22.000000000 -0400
@@ -1,11 +1,11 @@
 ;;; diminish.el --- Diminished modes are minor modes with no modeline display
 
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2003 Free Software Foundation, Inc.
 
 ;; Author: Will Mengarini 
 ;; URL: 
 ;; Created: Th 19 Feb 98
-;; Version: 0.44, Sa 23 Jan 99
+;; Version: 0.45, 18 Jun 2003
 ;; Keywords: extensions, diminish, minor, codeprose
 
 ;; This file is part of GNU Emacs.
@@ -95,6 +95,11 @@
 ;; near the end of your .emacs file.  It should be near the end so that any
 ;; minor modes your .emacs loads will already have been loaded by the time
 ;; they're to be converted to diminished modes.
+;;
+;; Alternatively, you can setup dimished modes using the customize
+;; interface by customizing the variable `diminished-minor-modes'.  The
+;; same caveat as above applies and the minor mode libraries should be
+;; loaded in ~/.emacs before the `(custom-set-variables' line.
 
 ;; To diminish a major mode, (setq mode-name "whatever") in the mode hook.
 
@@ -104,6 +109,21 @@
 ;;          by our facility with language."
 ;;               --J. Michael Straczynski
 
+
+;;; History:
+;;
+;; 2003-06-08 Peter S. Galbraith 
+;;
+;;  - Make diminished-minor-modes a defcustom.  You can now setup the
+;;    package using `M-x customize-variable[RET]diminished-minor-modes[RET]'.
+;;
+;;    The minor modes still need to be loaded in ~/.emacs prior to diminish
+;;    setup but I'm not too sure how to best handle that.  An list of 
+;;    (MINOR-MODE . LIBRARY-FILE) obtained by pre-parsing the Emacs elisp
+;;    files perhaps, and then add an eval-after-load?  Seems like a kludge
+;;    because it relies on outside information remaining constant, but it
+;;    would help.
+
 ;;; Code:
 
 (eval-when-compile (require 'cl))
@@ -152,7 +172,7 @@
 ;; perhaps at first in surprise, the freedom they thus gain, and grow strong.
 
 ;;;###autoload
-(defun diminish (mode &optional to-what)
+(defun diminish (mode &optional to-what annotate-flag)
   "Diminish mode-line display of minor mode MODE to TO-WHAT (default \"\").
 
 Interactively, enter (with completion) the name of any minor mode, followed
@@ -167,7 +187,10 @@
 letters for some modes, without leading spaces.  Capitalizing them works
 best; if you then diminish some mode to \"X\" but have abbrev-mode enabled as
 well, you'll get a display like \"AbbrevX\".  This function prepends a space
-to TO-WHAT if it's > 1 char long & doesn't already begin with a space."
+to TO-WHAT if it's > 1 char long & doesn't already begin with a space.
+
+If ANNOTATE-FLAG is nil or omitted, the normal case in interactive use, then
+the variable `diminished-minor-modes' will be modified to reflect the change."
   (interactive (list (read (completing-read
                             "Diminish what minor mode: "
                             (mapcar (lambda (x) (list (symbol-name (car x))))
@@ -184,7 +207,11 @@
           (callf2 concat " " to-what)))
     (or (assq mode diminished-mode-alist)
         (push (copy-sequence minor) diminished-mode-alist))
-    (setcdr minor (list to-what))))
+    (setcdr minor (list to-what))
+    (if (not annotate-flag)
+        (setq diminished-minor-modes
+              (append diminished-minor-modes
+                      (list (cons (car minor) to-what)))))))
 
 ;; But an image comes to me, vivid in its unreality, of a loon alone on his
 ;; forest lake, shrieking his soul out into a canopy of stars.  Alone this
@@ -203,7 +230,7 @@
 ;; He was shot dead by police.
 
 ;;;###autoload
-(defun diminish-undo (mode)
+(defun diminish-undo (mode &optional annotate-flag)
   "Restore mode-line display of diminished mode MODE to its minor-mode value.
 Do nothing if the arg is a minor mode that hasn't been diminished.
 
@@ -211,7 +238,10 @@
 mode that was formerly a minor mode on which you invoked M-x diminish).
 To restore all diminished modes to minor status, answer `diminished-modes'.
 The response to the prompt shouldn't be quoted.  However, in Lisp code,
-the arg must be quoted as a symbol, as in (diminish-undo 'diminished-modes)."
+the arg must be quoted as a symbol, as in (diminish-undo 'diminished-modes).
+
+If ANNOTATE-FLAG is nil or omitted, the normal case in interactive use, then
+the variable `diminished-minor-modes' will be modified to reflect the change."
   (interactive
    (list (read (completing-read
                 "Restore what diminished mode: "
@@ -229,7 +259,10 @@
       (or minor
           (error "%S is not currently registered as a minor mode" mode))
       (when diminished
-        (setcdr minor (cdr diminished))))))
+        (setcdr minor (cdr diminished))
+        (when (not annotate-flag)
+          (setq diminished-minor-modes
+                (assq-delete-all (car minor) diminished-minor-modes)))))))
 
 ;; Plumber Bob was not from Seattle, my grey city, for rainy Seattle is a
 ;; city of interiors, a city of the self-diminished.  When I moved here one
@@ -288,6 +321,31 @@
 ;; in line with the ducks and geese at the espresso counter, gazing placidly
 ;; out on the world through loon-red eyes, thinking secret thoughts.
 
+(defgroup diminish nil
+  "Diminished modes are minor modes with no modeline display."
+  :group 'convenience)
+
+(defcustom diminished-minor-modes nil
+  "List of minor modes to diminish and their mode line display strings.
+The display string can be the empty string if you want the name of the mode
+completely removed from the mode line.  If you prefer, you can abbreviate
+the name.  For 2 characters or more will be displayed as a separate word on
+the mode line, just like minor modes' names.  A single character will be
+scrunched up against the previous word.  Multiple single-letter diminished
+modes will all be scrunched together.
+
+The display of undiminished modes will not be affected."
+  :group 'diminish
+  :type '(alist :key-type (symbol :tag "Minor-mode")
+		:value-type (string :tag "Title"))
+  :options (mapcar 'car minor-mode-alist)
+  :set (lambda (symbol value)
+         (if (and (boundp 'diminished-minor-modes) diminished-minor-modes)
+             (mapcar 
+              (lambda (x) (diminish-undo (car x) t)) diminished-minor-modes))
+         (set-default symbol value)
+         (mapcar (lambda (x) (diminish (car x) (cdr x) t)) value)))
+
 (provide 'diminish)
 
-;;; diminish.el ends here
\ No newline at end of file
+;;; diminish.el ends here
emacs-goodies-el-35.8ubuntu2/debian/patches/series0000775000000000000000000000204312230377266017103 0ustar  40_missing_provide.diff
49_bar-cursor-customize.diff
50_bar-cursor_bug331430.diff
50_browse-kill-ring_bug224751.diff
50_ctypes.diff
50_coffee_no-autoload.diff
50_color-theme_custom.diff
50_dedicated.diff
50_dict_bug301293.diff
50_diminish-defcustom.diff
51_diminishSamuelBronson.diff
50_edit-env_autoload.diff
51_edit-env_copy-list.diff
50_filladapt_bug420845.diff
50_gnus-BTS.diff
51_gnus-BTS_bug363161.diff
52_gnus-BTS_bug218286.diff
50_gnus-filterhist.diff
50_gnus-pers.diff
51_gnus-pers.diff
52_gnus-pers.diff
53_gnus-pers.diff
54_gnus-pers_bug384209.diff
55_gnus-pers_bug263371.diff
50_highlight-beyond-fill-column.diff
50_joc-toggle-case.diff
50_joc-toggle-buffer.diff
50_maplev_bug528868.diff
50_marker-visit_autoloads.diff
50_session_enable_custom.diff
51_session_autoload.diff
50_silly-mail.diff
50_slang-mode_bug336352.diff
50_protbuf_custom_and_toggle.diff
50_todoo_bug220718.diff
51_todoo_bug267637.diff
52_todoo_bug414781.diff
53_todoo_bug438964.diff
50_setnu.diff
50_quack_autoload.diff
50_vm-bogofilter.diff
56_make_local_hook.diff
50_tlc.diff
emacs-goodies-el-35.8ubuntu2/debian/patches/50_protbuf_custom_and_toggle.diff0000775000000000000000000001643012230377266024267 0ustar  #!/bin/sh -e
## 50_protbuf_custom_and_toggle.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: protbuf - custom support + true toggles.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/protbuf.el emacs-goodies-el/elisp/emacs-goodies-el/protbuf.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/protbuf.el	2003-10-07 19:18:26.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/protbuf.el	2003-10-07 21:20:08.000000000 -0400
@@ -29,24 +29,49 @@
 
 ;; This package allows you to make it harder to kill buffers accidentally,
 ;; e.g. by being too trigger happy selecting items in the buffer menu.
-;; protect-process-buffer-from-kill-mode is perhaps the more useful of the
-;; two, making it harder to accidentally kill shell buffers without
+;;
+;; The commands are:
+;;
+;; `protect-buffer-from-kill-mode'
+;;   Toggle kill-buffer protection on current buffer.
+;;
+;; `protect-process-buffer-from-kill-mode'
+;;   Toggle kill-buffer protection on current buffer with active process.
+;;   Protection only applies as long as the buffer has an active process.
+;;
+;; `protect-process-buffer-from-kill-mode' is perhaps the more useful of
+;; the two, making it harder to accidentally kill shell buffers without
 ;; terminating the process in them first.
 
+;;; History:
+;;
+;; 2003-10-07 Peter S Galbraith 
+;;  - custom interface support.
+;;  - make interactive commands toggle the minor-mode.
+;;  - some checkdoc changes.
+
 ;;; Code:
 
-(defvar protect-buffer-verbose t
-  "*If non-nil, print a message when attempting to kill a protected buffer.")
+(defgroup protect-buffer nil
+  "Protect buffers from accidental killing."
+  :group 'killing)
 
-(defvar protect-buffer-bury-p t
+(defcustom protect-buffer-verbose t
+  "*If non-nil, print a message when attempting to kill a protected buffer."
+  :type 'boolean
+  :group 'protect-buffer)
+
+(defcustom protect-buffer-bury-p t
   "*If non-nil, bury buffer when attempting to kill it.
 This only has an effect if the buffer to be killed is the one
-visible in the selected window.")
+visible in the selected window."
+  :type 'boolean
+  :group 'protect-buffer)
 
 
 ;;;###autoload
 (defvar protect-buffer-from-kill-mode nil
-  "*If non-`nil', then prevent buffer from being accidentally killed.
+  "*If non-nil, then prevent buffer from being accidentally killed.
 This variable is local to all buffers.")
 (progn
   (make-variable-buffer-local 'protect-buffer-from-kill-mode)
@@ -57,7 +82,7 @@
 
 ;;;###autoload
 (defvar protect-process-buffer-from-kill-mode nil
-  "*If non-`nil', then protect buffer with live process from being killed.
+  "*If non-nil, then protect buffer with live process from being killed.
 This variable is local to all buffers.")
 (progn
   (make-variable-buffer-local 'protect-process-buffer-from-kill-mode)
@@ -84,32 +109,26 @@
 
 ;;;###autoload
 (defun protect-buffer-from-kill-mode (&optional prefix buffer)
-  "Protect buffer from being killed.
-To remove this protection, call this command with a negative prefix argument."
+  "Toggle `kill-buffer' protection on current buffer.
+Optionally, set a PREFIX argument to set or unset protection, and specify
+alternate BUFFER."
   (interactive "P")
-  (or buffer (setq buffer (current-buffer)))
   (save-excursion
-    ;; Each cond does its own set-buffer *after* comparing prefix just in
-    ;; case there's a buffer-local variable `prefix' to screw up the works.
-    (cond
-     ((null prefix)
-      (set-buffer buffer)
-      (setq protect-buffer-from-kill-mode
-            (not protect-buffer-from-kill-mode)))
-     ((>= prefix 0)
-      (set-buffer buffer)
-      (setq protect-buffer-from-kill-mode t))
-     (t
-      (set-buffer buffer)
-      (setq protect-buffer-from-kill-mode nil)))
+    (if buffer
+        (set-buffer buffer))
+    (set (make-local-variable 'protect-buffer-from-kill-mode)
+         (if prefix
+             (> (prefix-numeric-value prefix) 0)
+           (not protect-buffer-from-kill-mode)))
     ;; This is always done because kill-buffer-query-functions might have
     ;; been buffer-local when this package was initially loaded, leaving
     ;; the global value unchanged.
     (add-hook 'kill-buffer-query-functions 'protect-buffer-from-kill)))
 
-;; This function is listed in kill-buffer-query-functions; it should return
-;; nil if the buffer should not be killed, t otherwise.
 (defun protect-buffer-from-kill ()
+  "Implements protection from buffer killing.
+This function is listed in `kill-buffer-query-functions'; it should return
+nil if the buffer should not be killed, t otherwise."
   (cond
    (protect-buffer-from-kill-mode
     (and protect-buffer-verbose
@@ -125,32 +144,27 @@
 
 ;;;###autoload
 (defun protect-process-buffer-from-kill-mode (&optional prefix buffer)
-  "Protect buffer from being killed as long as it has an active process.
-To remove this protection, call this command with a negative prefix argument."
+  "Toggle `kill-buffer' protection on current buffer with active process.
+Protection only applies as long as the buffer has an active process.
+Optionally, set a PREFIX argument to set or unset protection, and specify
+alternate BUFFER."
   (interactive "P")
-  (or buffer (setq buffer (current-buffer)))
   (save-excursion
-    ;; Each cond does its own set-buffer *after* comparing prefix just in
-    ;; case there's a buffer-local variable `prefix' to screw up the works.
-    (cond
-     ((null prefix)
-      (set-buffer buffer)
-      (setq protect-process-buffer-from-kill-mode
-            (not protect-process-buffer-from-kill-mode)))
-     ((>= prefix 0)
-      (set-buffer buffer)
-      (setq protect-process-buffer-from-kill-mode t))
-     (t
-      (set-buffer buffer)
-      (setq protect-process-buffer-from-kill-mode nil)))
+    (if buffer
+        (set-buffer buffer))
+    (set (make-local-variable 'protect-process-buffer-from-kill-mode)
+         (if prefix
+             (> (prefix-numeric-value prefix) 0)
+           (not protect-process-buffer-from-kill-mode)))
     ;; This is always done because kill-buffer-query-functions might have
     ;; been buffer-local when this package was initially loaded, leaving
     ;; the global value unchanged.
     (add-hook 'kill-buffer-query-functions 'protect-process-buffer-from-kill)))
 
-;; This function is listed in kill-buffer-query-functions; it should return
-;; nil if the buffer should be protected, t if buffer should be killed.
 (defun protect-process-buffer-from-kill ()
+  "Implements protection from buffer killing.
+This function is listed in `kill-buffer-query-functions'; it should return
+nil if the buffer should be protected, t if buffer should be killed."
   (cond
    ((not protect-process-buffer-from-kill-mode) t)
    ((or (and (boundp 'protect-process-buffer-from-kill-preserve-function)
emacs-goodies-el-35.8ubuntu2/debian/patches/54_gnus-pers_bug384209.diff0000775000000000000000000001253012230377266022304 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 54_gnus-pers_bug384209.dpatch by  
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/gnus-bonus-el/gnus-pers.el emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el
--- emacs-goodies-el~/elisp/gnus-bonus-el/gnus-pers.el	2007-09-17 22:10:14.000000000 -0400
+++ emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el	2007-09-17 22:11:38.000000000 -0400
@@ -69,6 +69,10 @@
 ;   `gnus-personalities-replace-in-string' after removing the calls to
 ;   check-argument-type.  This was listed in the Todo list.
 
+;; 1.3 Elias Oltmanns 
+;; Reported and fixed Debian bug #384209
+;; `Cc-fix feature in gnus-pers is horribly broken'
+
 ;Todo:
 ; + redo x-tra headers to be a repeat list of two parts, header name
 ; and header data. Then allow either to be a function.
@@ -82,6 +86,8 @@
 
 (eval-when-compile (require 'cl))
 (require 'nnmail)
+(autoload 'rmail-dont-reply-to "mail-utils")
+(autoload 'gnus-extract-address-components "gnus-util")
 
 ;; Variable setup
 
@@ -306,39 +312,6 @@
 
 (define-key message-mode-map "\C-c\C-p" 'gnus-personality-choose)
 
-(defun gnus-personality-replace-in-string (str regexp newtext &optional literal)
-  "Replace all matches in STR for REGEXP with NEWTEXT string,
- and returns the new string.
-Optional LITERAL non-nil means do a literal replacement.
-Otherwise treat `\\' in NEWTEXT as special:
-  `\\&' in NEWTEXT means substitute original matched text.
-  `\\N' means substitute what matched the Nth `\\(...\\)'.
-       If Nth parens didn't match, substitute nothing.
-  `\\\\' means insert one `\\'.
-  `\\u' means upcase the next character.
-  `\\l' means downcase the next character.
-  `\\U' means begin upcasing all following characters.
-  `\\L' means begin downcasing all following characters.
-  `\\E' means terminate the effect of any `\\U' or `\\L'.
-
-This is mostly copied from XEmacs' replace-in-string because Emacs doesn't
-have that function."
-  (if (> (length str) 50)
-      (let ((cfs case-fold-search))
-	(with-temp-buffer
-          (setq case-fold-search cfs)
-	  (insert str)
-	  (goto-char 1)
-	  (while (re-search-forward regexp nil t)
-	    (replace-match newtext t literal))
-	  (buffer-string)))
-  (let ((start 0) newstr)
-    (while (string-match regexp str start)
-      (setq newstr (replace-match newtext t literal str)
-	    start (+ (match-end 0) (- (length newstr) (length str)))
-	    str newstr))
-    str)))
-
 (defun gnus-personality-use (&optional personality)
   "Use a personality defined in gnus-personalities."
   (interactive)
@@ -504,27 +477,19 @@
 	  ; Now we have a problem with Cc when doing a followup. So let's check the Cc field and see if from is there:
 	  (save-excursion
 	    (save-restriction
-	      (message-goto-cc) ;; Yes, yes. This inserts a Cc: if there's nothing there. No worries.
-	      (beginning-of-line)
-	      (let ((beg (point))
-		    (email (gnus-personality-replace-in-string from "\"" "")))
-		(end-of-line)
-		(narrow-to-region beg (point))
-	      (goto-char (point-min))
-	      ; " mess me up.
-	      (while (search-forward "\"" nil t)
-		(replace-match "")
-		)
-	      (goto-char (point-min))
-		(if (search-forward email nil t)
-		    (let* ((end (match-end 0))
-			   (start (match-beginning 0)))
-		      (delete-region start end))) ; Excellent. Now we need to check for a blank line.
-		(unless (re-search-forward ".*@.*" nil t)
+	      (message-narrow-to-head)
+	      (let ((case-fold-search t)
+		    (rmail-dont-reply-to-names
+		     (regexp-quote
+		      (cadr (gnus-extract-address-components from))))
+		    (cc (message-fetch-field "cc")))
+		(when (and cc
+			   (string-match rmail-dont-reply-to-names cc))
+		  (message-remove-header "cc")
 		  (widen)
-		  (forward-line 1)
-		  (beginning-of-line)
-		  (delete-region beg (point)))
+		  (unless (string= "" (setq cc (rmail-dont-reply-to cc)))
+		    (message-goto-cc)
+		    (insert cc)))
 
 	      )
 	    )
@@ -652,27 +617,19 @@
 	  ; Now we have a problem with Cc when doing a followup. So let's check the Cc field and see if from is there:
 	  (save-excursion
 	    (save-restriction
-	      (message-goto-cc) ;; Yes, yes. This inserts a Cc: if there's nothing there. No worries.
-	      (beginning-of-line)
-	      (let ((beg (point))
-		    (email (gnus-personality-replace-in-string from "\"" "")))
-		(end-of-line)
-		(narrow-to-region beg (point))
-	      (goto-char (point-min))
-	      ; " mess me up.
-	      (while (search-forward "\"" nil t)
-		(replace-match "")
-		)
-	      (goto-char (point-min))
-		(if (search-forward email nil t)
-		    (let* ((end (match-end 0))
-			   (start (match-beginning 0)))
-		      (delete-region start end))) ; Excellent. Now we need to check for a blank line.
-		(unless (re-search-forward ".*@.*" nil t)
+	      (message-narrow-to-head)
+	      (let ((case-fold-search t)
+		    (rmail-dont-reply-to-names
+		     (regexp-quote
+		      (cadr (gnus-extract-address-components from))))
+		    (cc (message-fetch-field "cc")))
+		(when (and cc
+			   (string-match rmail-dont-reply-to-names cc))
+		  (message-remove-header "cc")
 		  (widen)
-		  (forward-line 1)
-		  (beginning-of-line)
-		  (delete-region beg (point)))
+		  (unless (string= "" (setq cc (rmail-dont-reply-to cc)))
+		    (message-goto-cc)
+		    (insert cc)))
 
 	      )
 	    )
emacs-goodies-el-35.8ubuntu2/debian/patches/53_gnus-pers.diff0000775000000000000000000000556512230377266020766 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 53_gnus-pers.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
--- a/elisp/gnus-bonus-el/gnus-pers.el
+++ b/elisp/gnus-bonus-el/gnus-pers.el
@@ -361,8 +361,8 @@
 		    ((stringp fromfoo)
 		    fromfoo)
 		   ((or (symbolp fromfoo)
-			(gnus-functionp fromfoo))
-		    (cond ((gnus-functionp fromfoo)
+			(functionp fromfoo))
+		    (cond ((functionp fromfoo)
 			   (funcall fromfoo))
 			  ((boundp fromfoo)
 			   (symbol-value fromfoo))))
@@ -375,8 +375,8 @@
 		    ((stringp extrasfoo)
 		    extrasfoo)
 		   ((or (symbolp extrasfoo)
-			(gnus-functionp extrasfoo))
-		    (cond ((gnus-functionp extrasfoo)
+			(functionp extrasfoo))
+		    (cond ((functionp extrasfoo)
 			   (funcall extrasfoo))
 			  ((boundp extrasfoo)
 			   (symbol-value extrasfoo))))
@@ -422,8 +422,8 @@
 		     ((stringp fromfoo)
 		      fromfoo)
 		     ((or (symbolp fromfoo)
-			  (gnus-functionp fromfoo))
-		      (cond ((gnus-functionp fromfoo)
+			  (functionp fromfoo))
+		      (cond ((functionp fromfoo)
 			     (funcall fromfoo))
 			    ((boundp fromfoo)
 			     (symbol-value fromfoo))))
@@ -436,8 +436,8 @@
 		       ((stringp extrasfoo)
 			extrasfoo)
 		       ((or (symbolp extrasfoo)
-			    (gnus-functionp extrasfoo))
-			(cond ((gnus-functionp extrasfoo)
+			    (functionp extrasfoo))
+			(cond ((functionp extrasfoo)
 			       (funcall extrasfoo))
 			      ((boundp extrasfoo)
 			       (symbol-value extrasfoo))))
@@ -450,8 +450,8 @@
 			  ((stringp signaturesfoo)
 			   signaturesfoo)
 			  ((or (symbolp signaturesfoo)
-			       (gnus-functionp signaturesfoo))
-			   (cond ((gnus-functionp signaturesfoo)
+			       (functionp signaturesfoo))
+			   (cond ((functionp signaturesfoo)
 				  (funcall signaturesfoo))
 				 ((boundp signaturesfoo)
 				  (symbol-value signaturesfoo))))
@@ -581,8 +581,8 @@
 		    ((stringp fromfoo)
 		    fromfoo)
 		   ((or (symbolp fromfoo)
-			(gnus-functionp fromfoo))
-		    (cond ((gnus-functionp fromfoo)
+			(functionp fromfoo))
+		    (cond ((functionp fromfoo)
 			   (funcall fromfoo))
 			  ((boundp fromfoo)
 			   (symbol-value fromfoo))))
@@ -595,8 +595,8 @@
 		    ((stringp extrasfoo)
 		    extrasfoo)
 		   ((or (symbolp extrasfoo)
-			(gnus-functionp extrasfoo))
-		    (cond ((gnus-functionp extrasfoo)
+			(functionp extrasfoo))
+		    (cond ((functionp extrasfoo)
 			   (funcall extrasfoo))
 			  ((boundp extrasfoo)
 			   (symbol-value extrasfoo))))
@@ -609,8 +609,8 @@
 			 ((stringp signaturesfoo)
 			  signaturesfoo)
 			 ((or (symbolp signaturesfoo)
-			      (gnus-functionp signaturesfoo))
-			  (cond ((gnus-functionp signaturesfoo)
+			      (functionp signaturesfoo))
+			  (cond ((functionp signaturesfoo)
 				 (funcall signaturesfoo))
 				((boundp signaturesfoo)
 				 (symbol-value signaturesfoo))))
emacs-goodies-el-35.8ubuntu2/debian/patches/51_gnus-pers.diff0000775000000000000000000000251412230377266020753 0ustar  #!/bin/sh -e
## 51_gnus-pers.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Make sure we're in mail header (See bug #240212)

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el	2004-08-16 20:49:16.000000000 -0400
+++ emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el	2004-08-16 20:51:59.000000000 -0400
@@ -474,6 +474,7 @@
 					;Let's do From: first.
 	  (if (and from (not (equal from "")))
 	      (progn
+                (goto-char (point-min)) ;Make sure we're in the header
 		(let ((endpos (search-forward mail-header-separator)))
 		  (goto-char (point-min))
 		  (if (re-search-forward "^From:" endpos t)
emacs-goodies-el-35.8ubuntu2/debian/patches/53_todoo_bug438964.diff0000775000000000000000000000360712230377266021521 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 53_todoo_bug438964.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/emacs-goodies-el/todoo.el emacs-goodies-el/elisp/emacs-goodies-el/todoo.el
--- emacs-goodies-el~/elisp/emacs-goodies-el/todoo.el	2007-10-23 20:27:08.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/todoo.el	2007-10-23 20:27:56.000000000 -0400
@@ -57,6 +57,12 @@
 
 ;;; ChangeLog:
 
+;; 2007-08-29 Peter S Galbraith 
+
+;;  outline-font-lock-level is void, so define a similar one to historical
+;;  version from outline.el.  Call it todoo-outline-font-lock-level.
+;;  (Closes #438964)
+
 ;; 2007-05-14 Peter S Galbraith 
 ;;  Comment out clobbering of outline-mode-menu-bar-map key entries.
 ;;  This is far too aggressive.  A much better fix would be to undefine the
@@ -389,11 +395,21 @@
   (backward-char))
 
 
+(defun todoo-outline-font-lock-level ()
+  (let ((count 1))
+    (save-excursion
+      (outline-back-to-heading t)
+      (while (and (not (bobp))
+		  (not (eq (funcall outline-level) 1)))
+	(outline-up-heading 1)
+	(setq count (1+ count)))
+      count)))
+
 (defun todoo-insert-sub-item () 
   "Insert a new todoo-sub-item."
   (interactive)
   (goto-char (- (todoo-item-end) 1))
-  (insert (concat "\n" (make-string (* (- (outline-font-lock-level) 2)
+  (insert (concat "\n" (make-string (* (- (todoo-outline-font-lock-level) 2)
 			       todoo-indent-column) ? )
 		  todoo-sub-item-marker " \n"))
   (backward-char))
@@ -404,7 +420,7 @@
   (interactive)
   (beginning-of-line)
 
-  (let ((indent-column (* (- (outline-font-lock-level) 1)
+  (let ((indent-column (* (- (todoo-outline-font-lock-level) 1)
 			  todoo-indent-column)))
     (if (eq (point) (point-at-eol))
 	(insert (make-string indent-column ? )))
emacs-goodies-el-35.8ubuntu2/debian/patches/50_edit-env_autoload.diff0000775000000000000000000000235312230377266022433 0ustar  #!/bin/sh -e
## 50_edit-env_autoload.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Add autoload.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/newfiles/emacs-goodies-el/elisp/emacs-goodies-el/edit-env.el emacs-goodies-el/elisp/emacs-goodies-el/edit-env.el
--- /home/psg/emacs/emacs-goodies-el/newfiles/emacs-goodies-el/elisp/emacs-goodies-el/edit-env.el	2003-11-12 20:17:21.000000000 -0500
+++ emacs-goodies-el/elisp/emacs-goodies-el/edit-env.el	2003-11-14 15:00:01.000000000 -0500
@@ -111,6 +111,7 @@
 	       (list (widget-get widget 'environment-variable-name)
 		     widget)))
   
+;;;###autoload
 (defun edit-env ()
   "Display, edit, delete and add environment variables."
   (interactive)
emacs-goodies-el-35.8ubuntu2/debian/patches/56_make_local_hook.diff0000664000000000000000000000345712230377266022150 0ustar  --- a/elisp/emacs-goodies-el/egocentric.el
+++ b/elisp/emacs-goodies-el/egocentric.el
@@ -101,7 +101,8 @@
 
 (defvar egocentric-overlay-list nil
   "List of overlays used to highlight occurences of your name in `egocentric-mode'.")
-(make-local-variable 'egocentric-overlay-list)
+(if (fboundp 'make-local-hook)
+    (make-local-variable 'egocentric-overlay-list))
 
 (defvar egocentric-regexp-list nil
   "Regexp used to check whether a word has to be highlighted.
@@ -141,7 +142,8 @@
 (defun egocentric-mode-on ()
   "Turn Egocentric mode on."
   (interactive)
-  (make-local-hook 'post-command-hook)
+  (if (fboundp 'make-local-hook)
+      (make-local-hook 'post-command-hook))
   (add-hook 'post-command-hook (function egocentric-post-command-hook) t t)
   (egocentric-update-regexp-list)
   (egocentric-insinuate egocentric-regexp-list)
--- a/elisp/emacs-goodies-el/maplev.el
+++ b/elisp/emacs-goodies-el/maplev.el
@@ -1853,13 +1853,15 @@
   ;; the file's local variables specs might change maplev-release
   ;; xemacs version of make-local-hook returns t, not the hook. (JR)
   ;; make-local-hook is obsolete in GNU emacs 21.1
-  (make-local-hook 'hack-local-variables-hook)
+  (if (fboundp 'make-local-hook)
+      (make-local-hook 'hack-local-variables-hook))
   (add-hook 'hack-local-variables-hook 'maplev-mode-name nil t)
 
   ;; Set hooks
   (if maplev-clean-buffer-before-saving-flag
       (add-hook 'local-write-file-hooks 'maplev-remove-trailing-spaces))
-  (make-local-hook 'before-change-functions)
+  (if (fboundp 'make-local-hook)
+      (make-local-hook 'before-change-functions))
   (add-hook 'before-change-functions 'maplev--before-change-function nil t)
   (run-hooks 'maplev-mode-hook))
 
@@ -4887,4 +4889,4 @@
 
 (provide 'maplev)
 
-;;; maplev.el ends here
\ No newline at end of file
+;;; maplev.el ends here
emacs-goodies-el-35.8ubuntu2/debian/patches/50_filladapt_bug420845.diff0000775000000000000000000000163512230377266022316 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 50_filladapt_bug420845.dpatch by  
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/emacs-goodies-el/filladapt.el emacs-goodies-el/elisp/emacs-goodies-el/filladapt.el
--- emacs-goodies-el~/elisp/emacs-goodies-el/filladapt.el	2003-04-04 15:16:01.000000000 -0500
+++ emacs-goodies-el/elisp/emacs-goodies-el/filladapt.el	2007-05-14 19:41:02.000000000 -0400
@@ -72,7 +72,7 @@
 
 (provide 'filladapt)
 
-(defvar filladapt-version "2.12"
+(defvar filladapt-version "2.12debian"
   "Version string for filladapt.")
 
 ;; BLOB to make custom stuff work even without customize
@@ -620,6 +620,7 @@
 
 (defun turn-on-filladapt-mode ()
   "Unconditionally turn on Filladapt mode in the current buffer."
+  (interactive)
   (filladapt-mode 1))
 
 (defun turn-off-filladapt-mode ()
emacs-goodies-el-35.8ubuntu2/debian/patches/50_gnus-pers.diff0000775000000000000000000001446212230377266020757 0ustar  #!/bin/sh -e
## 50_gnus-pers.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el	2004-01-15 16:48:11.000000000 -0500
+++ emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el	2004-01-28 19:46:16.000000000 -0500
@@ -1,4 +1,4 @@
-;;; gnus-pers.el --- an alternative to gnus-posting-styles
+;;; gnus-pers.el --- implements personalities for gnus Message mode
 ;; Copyright (C) 1999 BrYan P. Johnson
 
 ;; Author: BrYan P. Johnson 
@@ -20,14 +20,28 @@
 
 ;;; Commentary:
 
-;; in your .gnus file:
-
-;; (require 'gnus-pers)
-;; (gnus-personality-init)
+;; gnus-pers implements personalities for Message mode.
+;;
+;; It allows you to define a personality with any e-mail address, extra
+;; headers and signature you like, either as strings, functions or variables
+;; (signatures may also be files). Then it will chose a personality for you
+;; based on header info, gnus-newsgroup-name or group
+;; parameter. Additionally, you can change a personality in the middle of
+;; writing a message. This is intended to be an alternative to
+;; gnus-posting-styles, which only sets personalities (posting styles) based
+;; on which group you are in. Also, gnus-posting-styles must be defined by
+;; editing a your .gnus whereas gnus-pers uses Xemacs customize facility.
 
-;; Then just M-x customize Personality
+;; To use, add this to your .gnus file:
+;;
+;;  (require 'gnus-pers)
+;;  (gnus-personality-init)
+;;
+;; Then setup and customize with:
+;;
+;;  M-x customize-group Personality'
 
-; History:
+;;; History:
 
 ; 1.0
 ; + Added check for personality group parameter. Use it to designate a
@@ -49,6 +63,12 @@
 ; + Stole message-insert-signature and changed a tad to fix the extra newline in signature when switching personalities bug. see gnus-pers-insert-signature
 ; + Added ability to use gnus-newsgroup-name as an electric criteria.
 
+; 1.2 Peter S. Galbraith 
+; + Use functionp instead of message-functionp since gnus no longer defines it.
+; + Copy replace-in-string from XEmacs, name it
+;   `gnus-personalities-replace-in-string' after removing the calls to
+;   check-argument-type.  This was listed in the Todo list.
+
 ;Todo:
 ; + redo x-tra headers to be a repeat list of two parts, header name
 ; and header data. Then allow either to be a function.
@@ -57,23 +77,6 @@
 ; + BBDB integration
 ; + Have from and extra headers possibly be files as well.
 ; + Electric rescan buffer
-; + maybe fix replace-in-string call.
-;From: Christoph Conrad 
-;    BrYan> `replace-in-string' is a compiled Lisp function
-;    BrYan> -- loaded from
-;    BrYan> "/usr/src/bs/BUILD/xemacs-21.1.2/building/i386-linux/lisp/subr.elc"
-
-
-;    BrYan> Hrm. I don't use emacs, don't think I even have it
-;    BrYan> installed. I'll poke around and see if there's something
-;    BrYan> similar in emacs.
-
-;I didn't found anything similiar, so i took the original function and
-;eliminated the two first statements with
-
-;;;;  (check-argument-type 'stringp str)
-;;;;  (check-argument-type 'stringp newtext)
-
 
 ;;; Code:
 
@@ -303,6 +306,39 @@
 
 (define-key message-mode-map "\C-c\C-p" 'gnus-personality-choose)
 
+(defun gnus-personality-replace-in-string (str regexp newtext &optional literal)
+  "Replace all matches in STR for REGEXP with NEWTEXT string,
+ and returns the new string.
+Optional LITERAL non-nil means do a literal replacement.
+Otherwise treat `\\' in NEWTEXT as special:
+  `\\&' in NEWTEXT means substitute original matched text.
+  `\\N' means substitute what matched the Nth `\\(...\\)'.
+       If Nth parens didn't match, substitute nothing.
+  `\\\\' means insert one `\\'.
+  `\\u' means upcase the next character.
+  `\\l' means downcase the next character.
+  `\\U' means begin upcasing all following characters.
+  `\\L' means begin downcasing all following characters.
+  `\\E' means terminate the effect of any `\\U' or `\\L'.
+
+This is mostly copied from XEmacs' replace-in-string because Emacs doesn't
+have that function."
+  (if (> (length str) 50)
+      (let ((cfs case-fold-search))
+	(with-temp-buffer
+          (setq case-fold-search cfs)
+	  (insert str)
+	  (goto-char 1)
+	  (while (re-search-forward regexp nil t)
+	    (replace-match newtext t literal))
+	  (buffer-string)))
+  (let ((start 0) newstr)
+    (while (string-match regexp str start)
+      (setq newstr (replace-match newtext t literal str)
+	    start (+ (match-end 0) (- (length newstr) (length str)))
+	    str newstr))
+    str)))
+
 (defun gnus-personality-use (&optional personality)
   "Use a personality defined in gnus-personalities."
   (interactive)
@@ -470,7 +506,7 @@
 	      (message-goto-cc) ;; Yes, yes. This inserts a Cc: if there's nothing there. No worries.
 	      (beginning-of-line)
 	      (let ((beg (point))
-		    (email (replace-in-string from "\"" "")))
+		    (email (gnus-personality-replace-in-string from "\"" "")))
 		(end-of-line)
 		(narrow-to-region beg (point))
 	      (goto-char (point-min))
@@ -618,7 +654,7 @@
 	      (message-goto-cc) ;; Yes, yes. This inserts a Cc: if there's nothing there. No worries.
 	      (beginning-of-line)
 	      (let ((beg (point))
-		    (email (replace-in-string from "\"" "")))
+		    (email (gnus-personality-replace-in-string from "\"" "")))
 		(end-of-line)
 		(narrow-to-region beg (point))
 	      (goto-char (point-min))
@@ -698,7 +734,7 @@
 	   ((and (null message-signature)
 		 force)
 	    t)
-	   ((message-functionp message-signature)
+	   ((functionp message-signature)
 	    (funcall message-signature))
 	   ((listp message-signature)
 	    (eval message-signature))
emacs-goodies-el-35.8ubuntu2/debian/patches/50_maplev_bug528868.diff0000664000000000000000000000073512230377266021655 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 50_maplev_bug528868.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
--- a/elisp/emacs-goodies-el/maplev.texi
+++ b/elisp/emacs-goodies-el/maplev.texi
@@ -11,6 +11,11 @@
 
 @include version.texi
 
+@dircategory Emacs
+@direntry
+* maplev: (maplev). Emacs major mode for Maple V
+@end direntry
+
 @iftex
 @tolerance 10000
 @end iftex
emacs-goodies-el-35.8ubuntu2/debian/patches/49_bar-cursor-customize.diff0000775000000000000000000001534412230377266023143 0ustar  #!/bin/sh -e
## 3_bar-cursor-customize.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/bar-cursor.el emacs-goodies-el/elisp/emacs-goodies-el/bar-cursor.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/bar-cursor.el	2003-10-05 15:12:44.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/bar-cursor.el	2003-10-05 15:14:54.000000000 -0400
@@ -3,7 +3,7 @@
 
 ;; This file is not part of Emacs
 
-;; Copyright (C) 2001 by Joseph L. Casadonte Jr.
+;; Copyright (C) 2001, 2003 by Joseph L. Casadonte Jr.
 ;; Author:          Joe Casadonte (emacs@northbound-train.com)
 ;; Maintainer:      Joe Casadonte (emacs@northbound-train.com)
 ;; Created:         July 1, 2001
@@ -44,13 +44,17 @@
 ;;
 ;;  To add a directory to your load-path, use something like the following:
 ;;
-;;      (add-to-list 'load-path (expand-file-name "/some/load/path"))
+;;     (add-to-list 'load-path (expand-file-name "/some/load/path"))
 
 ;;; Usage:
 ;;
 ;;  M-x `bar-cursor-mode'
 ;;      Toggles bar-cursor-mode on & off.  Optional arg turns
-;;      bar-cursor-mode on iff arg is a positive integer.
+;;      bar-cursor-mode on if arg is a positive integer.
+;;
+;;  You may also use the custom interface to enable or disable it:
+;;
+;;  M-x customize-variable [RET] bar-cursor-mode [RET]
 
 ;;; To Do:
 ;;
@@ -60,6 +64,9 @@
 ;;
 ;;  The basis for this code comes from Steve Kemp by way of the
 ;;  NTEmacs mailing list.
+;;
+;;  Peter S. Galbraith  contributed a patch making
+;;  bar-cursor-mode customizable.
 
 ;;; Comments:
 ;;
@@ -85,7 +92,9 @@
 (eval-when-compile
   ;; silence the old byte-compiler
   (defvar byte-compile-dynamic nil)
-  (set (make-local-variable 'byte-compile-dynamic) t))
+  (set (make-local-variable 'byte-compile-dynamic) t)
+  (require 'advice)
+  (defvar bar-cursor-mode))
 
 ;;; **************************************************************************
 ;;; ***** version related routines
@@ -109,43 +118,43 @@
 ;;; **************************************************************************
 ;;; ***** real functions
 ;;; **************************************************************************
-(defvar bar-cursor-mode nil "Non-nil if 'bar-cursor-mode' is enabled.")
 
-;;; --------------------------------------------------------------------------
 ;;;###autoload
 (defun bar-cursor-mode (&optional arg)
-  "Toggle use of 'bar-cursor-mode'.
-
+  "Toggle use of variable `bar-cursor-mode'.
 This quasi-minor mode changes cursor to a bar cursor in insert mode,
 and a block cursor in overwrite mode.  It may only be turned on and
 off globally, not on a per-buffer basis (hence the quasi- designation).
 
-Optional ARG turns mode on iff ARG is a positive integer."
+Optional ARG turns mode on if ARG is a positive integer."
   (interactive "P")
 
   ;; toggle on and off
   (let ((old-mode bar-cursor-mode))
-	(setq bar-cursor-mode
-		  (if arg (or (listp arg)
-					  (> (prefix-numeric-value arg) 0))
-			(not bar-cursor-mode)))
+    (setq bar-cursor-mode
+          (if arg (or (listp arg)
+                      (> (prefix-numeric-value arg) 0))
+            (not bar-cursor-mode)))
+    
+    (when (not (equal old-mode bar-cursor-mode))
+      (bar-cursor-change))))
 
-	(when (not (equal old-mode bar-cursor-mode))
-	  ;; enable/disable advice
-	  (if bar-cursor-mode
-		  (ad-enable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad)
-		(ad-disable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad))
+;;;###autoload
+(defun bar-cursor-change ()
+  "Enable or disable advice based on value of variable `bar-cursor-mode'."
+  (if bar-cursor-mode
+      (ad-enable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad)
+    (ad-disable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad))
 
-	  (ad-activate 'overwrite-mode)
+  (ad-activate 'overwrite-mode)
 
-	  ;; set the initial cursor type now
-	  (bar-cursor-set-cursor)
+  ;; set the initial cursor type now
+  (bar-cursor-set-cursor)
 
-	  ;; add or remove to frame hook
-	  (if bar-cursor-mode
-		  (add-hook 'after-make-frame-functions 'bar-cursor-set-cursor)
-		(remove-hook 'after-make-frame-functions 'bar-cursor-set-cursor))
-	  )))
+  ;; add or remove to frame hook
+  (if bar-cursor-mode
+      (add-hook 'after-make-frame-functions 'bar-cursor-set-cursor)
+    (remove-hook 'after-make-frame-functions 'bar-cursor-set-cursor)))
 
 ;;;--------------------------------------------------------------------------
 (defadvice overwrite-mode (after bar-cursor-overwrite-mode-ad disable)
@@ -154,7 +163,7 @@
 
 ;;;--------------------------------------------------------------------------
 (defun bar-cursor-set-cursor-type (cursor &optional frame)
-  "Set the cursor-type for the named frame.
+  "Set the `cursor-type' for the named frame.
 
 CURSOR is the name of the cursor to use (bar or block -- any others?).
 FRAME is optional frame to set the cursor for; current frame is used
@@ -169,7 +178,7 @@
 
 ;;; --------------------------------------------------------------------------
 (defun bar-cursor-set-cursor (&optional frame)
-  "Set the cursor-type according to the insertion mode.
+  "Set the `cursor-type' according to the insertion mode.
 
 FRAME is optional frame to set the cursor for; current frame is used
 if not passed in."
@@ -177,6 +186,23 @@
 	  (bar-cursor-set-cursor-type 'bar frame)
 	(bar-cursor-set-cursor-type 'block frame)))
 
+;;; --------------------------------------------------------------------------
+(defgroup bar-cursor nil
+  "switch block cursor to a bar."
+  :group 'convenience)
+
+(defcustom bar-cursor-mode nil
+  "*Non-nil means to convert the block cursor into a bar cursor.
+In overwrite mode, the bar cursor changes back into a block cursor.
+This is a quasi-minor mode, meaning that it can be turned on & off easily
+though only globally (hence the quasi-)"
+  :type 'boolean
+  :group 'bar-cursor
+  :require 'bar-cursor
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (bar-cursor-change)))
+
 ;;; **************************************************************************
 ;;; ***** we're done
 ;;; **************************************************************************
emacs-goodies-el-35.8ubuntu2/debian/patches/50_session_enable_custom.diff0000664000000000000000000000236212230377266023410 0ustar  #!/bin/sh -e
## 50_session_enable_custom.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
--- a/elisp/emacs-goodies-el/session.el
+++ b/elisp/emacs-goodies-el/session.el
@@ -244,7 +244,12 @@
 		      (const :tag "Load/Save Session" session)
 		      (const :tag "Store/Use Places" places)
 		      (const :tag "Setup Key/Mouse Bindings" keys)
-		      (const :tag "Setup Menus" menus))))
+		      (const :tag "Setup Menus" menus)))
+  :require 'session
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (when value
+           (add-hook 'after-init-hook 'session-initialize))))
 
 
 ;;;===========================================================================
emacs-goodies-el-35.8ubuntu2/debian/patches/50_tlc.diff0000664000000000000000000000062412227276246017610 0ustar  --- a/elisp/emacs-goodies-el/tlc.el
+++ b/elisp/emacs-goodies-el/tlc.el
@@ -299,8 +299,8 @@
 	nil))))
 
 ;;; Add to mode list
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.tlc\\'" .tlc-mode))
-(add-to-list 'auto-mode-alist '("\\.tlc\\'" .tlc-mode))
+;;;###autoload(add-to-list 'auto-mode-alist '("\\.tlc\\'" . tlc-mode))
+(add-to-list 'auto-mode-alist '("\\.tlc\\'" . tlc-mode))
 
 (provide 'tlc)
 
emacs-goodies-el-35.8ubuntu2/debian/patches/50_dedicated.diff0000775000000000000000000000506012230377267020735 0ustar  #!/bin/sh -e
## 50_dedicated.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: made a true toggle; added autoload tag.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/newfiles/emacs-goodies-el/elisp/emacs-goodies-el/dedicated.el emacs-goodies-el/elisp/emacs-goodies-el/dedicated.el
--- /home/psg/emacs/emacs-goodies-el/newfiles/emacs-goodies-el/elisp/emacs-goodies-el/dedicated.el	2003-11-12 20:51:41.000000000 -0500
+++ emacs-goodies-el/elisp/emacs-goodies-el/dedicated.el	2003-11-12 20:18:53.000000000 -0500
@@ -4,7 +4,7 @@
 
 ;; Author: Eric Crampton 
 ;; Maintainer: Eric Crampton 
-;; Version: 1.0.0
+;; Version: 1.1.0
 ;; Keywords: dedicated, buffer
 
 ;; This file is not part of GNU Emacs.
@@ -34,16 +34,30 @@
 ;;
 ;; Dedicated buffers will have "D" shown in the mode line.
 
+;;; History:
+;; 
+;; 2003-11-12 Peter S Galbraith 
+;;  V1.0.0 found on gnu.emacs.sources archives for 2000/04/12:
+;;   http://groups.google.com/groups?selm=izn1mzrs60.fsf%40elmo.atdesk.com
+;;  V1.1.0 made `dedicated-mode' a true toggle; added autoload tag and made
+;;   minor checkdoc edits.
+
 ;;; Code:
 
 (defvar dedicated-mode nil
-  "Mode variable for dedicated minor mode.")
+  "Mode variable for dedicated minor mode.
+Use the command `dedicated-mode' to toggle or set this variable.")
 (make-variable-buffer-local 'dedicated-mode)
 
+;;;###autoload
 (defun dedicated-mode (&optional arg)
-  "Dedicated minor mode."
+  "Toggle dedicated minor mode.
+With ARG, turn minor mode on if ARG is positive, off otherwise."
   (interactive "P")
-  (setq dedicated-mode (not dedicated-mode))
+  (setq hs-headline nil
+	dedicated-mode (if (null arg)
+                           (not dedicated-mode)
+                         (> (prefix-numeric-value arg) 0)))
   (set-window-dedicated-p (selected-window) dedicated-mode)
   (if (not (assq 'dedicated-mode minor-mode-alist))
       (setq minor-mode-alist
@@ -51,3 +65,5 @@
                   minor-mode-alist))))
 
 (provide 'dedicated)
+
+;;; dedicated.el ends here
emacs-goodies-el-35.8ubuntu2/debian/patches/52_gnus-BTS_bug218286.diff0000775000000000000000000000434012230377266021762 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 52_gnus-BTS_bug218286.dpatch by  
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/debian-el/gnus-BTS.el emacs-goodies-el/elisp/debian-el/gnus-BTS.el
--- emacs-goodies-el~/elisp/debian-el/gnus-BTS.el	2007-09-24 19:17:09.000000000 -0400
+++ emacs-goodies-el/elisp/debian-el/gnus-BTS.el	2007-09-24 19:23:14.000000000 -0400
@@ -3,7 +3,6 @@
 ;; Copyright (C) 2001 Andreas Fuchs 
 
 ;; Author: Andreas Fuchs
-;; Maintainer: Andreas Fuchs 
 ;; Keywords: gnus, Debian, Bug
 ;; Status: Works in XEmacs (I think >=21)
 ;; Created: 2001-02-07
@@ -59,6 +58,13 @@
 ;;      Wrong regexp part of gnus-dbts-debian-bug-regexp called by
 ;;      gnus-dbts-buttonize-debian (Closes #363161, #442438).
 ;;      
+;; 2007-09-24 intrigeri 
+;;            Peter S Galbraith 
+;;
+;;      Bug#218286: [Fwd: Re: [gnus-BTS] please make bug numbers in mail
+;;      clickable to read them as email.
+;;      Introduce `gnus-dbts-read-bugs-as-email'
+;;
 ;;; Code:
 
 
@@ -66,6 +72,12 @@
 
 (autoload 'thing-at-point "thingatpt")
 
+(defcustom gnus-dbts-read-bugs-as-email nil
+  "If t, highlighted Debian bug numbers' buttons call
+  `debian-bug-get-bug-as-email'; else, `browse-url' is used."
+  :type 'boolean
+  :group 'gnus-BTS)
+
 (defvar gnus-dbts-in-debian-group-p nil)
 
 (defvar gnus-dbts-in-debian-devel-announce-group-p nil)
@@ -102,6 +114,9 @@
 (defvar gnus-dbts-debian-reassign-regexp
   "reassigned from package `\\([^']*\\)' to `\\([^']*\\)'")
 
+;; debian-bug-get-bug-as-email autoload
+(require 'debian-el-loaddefs)
+
 (defun gnus-dbts-browse-debpkg-or-bug (thing)
   (interactive "i")
   (let* ((the-thing (if (null thing)
@@ -118,7 +133,9 @@
 		(concat
 		 "http://cgi.debian.org/cgi-bin/search_packages.pl"
 		 "?&searchon=names&version=all&release=all&keywords="))))
-    (browse-url (concat url bug-or-feature))))
+    (if (and bugp gnus-dbts-read-bugs-as-email)
+	(debian-bug-get-bug-as-email bug-or-feature)
+      (browse-url (concat url bug-or-feature)))))
 
 (defun gnus-dbts-buttonize-debian (regexp num predicate)
   (add-to-list 'gnus-button-alist
emacs-goodies-el-35.8ubuntu2/debian/patches/50_highlight-beyond-fill-column.diff0000775000000000000000000001645712230377266024506 0ustar  #!/bin/sh -e
## 5_highlight-beyond-fill-column.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Cleanup parens and create highlight-beyond-fill-column function

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/highlight-beyond-fill-column.el emacs-goodies-el/elisp/emacs-goodies-el/highlight-beyond-fill-column.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/highlight-beyond-fill-column.el	2003-09-19 19:52:15.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/highlight-beyond-fill-column.el	2003-09-20 14:26:58.000000000 -0400
@@ -1,15 +1,16 @@
-;;; highlight-beyond-fill-column.el --- font-lock-add-keywords aid for Emacs
+;;; highlight-beyond-fill-column.el --- fontify beyond the fill-column.
 
 ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+;; Copyright (C) 2003 Peter S Galbraith 
 
 ;; Author: Sandip Chitale (sandip.chitale@blazesoft.com)
 ;; Keywords: programming decipline convenience
 
 ;; Keywords:
 ;; Time-stamp: Aug 23 2001  8:56 PM Pacific Daylight Time
-;; Version: 1.1
+;; Version: 1.2
 
-;; This file is *NOT* (yet?) part of GNU Emacs.
+;; This file is not part of GNU Emacs.
 
 ;; 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
@@ -26,10 +27,11 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;; Commentary:
-
-;; This defines a function that can be used by `font-lock-add-keywords' to find the columns
-;; that are beyond `fill-column'.
+;;; Commentary:
+;; 
+;; This defines a function that can be used by `font-lock-add-keywords' to
+;; find the columns that are beyond `fill-column'.  It does not currently
+;; work in XEmacs because it lacks the funcyom `font-lock-add-keywords'.
 ;;
 ;; Installation:
 ;; Put the following in your .emacs
@@ -38,88 +40,70 @@
 ;;
 ;; Example usage:
 ;;
-;; Customize the `highlight-beyond-fill-column-in-modes' variable to
-;; setup the list of modes in which to highlight-beyond-fill-column
+;;   Enable it on a buffer using `M-x highlight-beyond-fill-column.
+;;   You may use that command in a hook (e.g. text-mode-hook)
 ;;
-;; Customize the `highlight-beyond-fill-column-face' variable to
-;; to setup the face used for highlight-beyond-fill-column
+;;   Customize the `highlight-beyond-fill-column-face' variable to
+;;   to setup the face used for highlight-beyond-fill-column
 ;;
 ;; Acknowledgement:
 ;;
 ;; This is based on initial code provided by Jim Janney (jjanney@xmission.com)
-;;
+
+;;; History:
+;; 
+;; V1.2 2003-09-12 by Peter S Galbraith 
+;; - Made checkdoc clean and fixed indentation and parentheses placement.
+;; - Added defgroup; used defface.
+;; - Removed `highlight-beyond-fill-column-in-modes' since it didn't work
+;;   anymore.
+;; - Created `highlight-beyond-fill-column' to use on a single buffer or as
+;;   a hook.
 
 ;;; Code:
-(defcustom highlight-beyond-fill-column-in-modes nil
-  "The list of modes in which to highlight-beyond-fill-column."
-  :group 'fill
-  :type  '(repeat string)
-  )
+(defgroup highlight-beyond-fill-column nil
+  "Fontify beyond the fill-column."
+  :group 'fill)
 
-(defcustom highlight-beyond-fill-column-face 'underline
-  "The face to use with highlight-beyond-fill-column."
-  :group 'fill
-  :type  'face
-  )
+(defface highlight-beyond-fill-column-face
+  '((t (:underline t)))
+  "Face used to highlight beyond the fill-column."
+  :group 'highlight-current-line)
 
-(defun find-after-fill-column (limit)
-  "A function that can be used by `font-lock-add-keywords' to find columns that are
-beyond the `fill-column'."
-  (let (
- ; remember the point
- (original-point (point))
- )
-    ; if already past the fill column start on next line
+(defun highlight-beyond-fill-column-lock (limit)
+  "Function for font-lock to highlight beyond the `fill-column' until LIMIT."
+  (let ((original-point (point)))       ;; remember the point
+    ;; if already past the fill column start on next line
     (if (> (current-column) fill-column)
- (forward-line 1)
-      )
-    (while (and (< (point) limit)                                     ; still within limit
-                    (or (< (move-to-column fill-column) fill-column)  ; the line has less than `fill-column' columns
-                        (= (point) (line-end-position))               ; end of line
-   )
-      )
-      ; goto next line
-      (forward-line 1)
-      )
+        (forward-line 1))
+    (while (and (< (point) limit)       ; still within limit
+                ;; the line has less than `fill-column' columns
+                (or (< (move-to-column fill-column) fill-column)
+                    (= (point) (line-end-position)))) ; end of line
+      ;; goto next line
+      (forward-line 1))
 
-    (if (>= (point) limit)                                            ; beyond limit
- (progn
-   (goto-char original-point)                                  ; restore point
-   nil                                                         ; return nil
-   )
-      (set-match-data (list (point-marker)                            ; set match data
-       (progn
-         (end-of-line)
-         (forward-char)                          ; this gives the highlight till the end of the window
-         (point-marker)
-         )
-       )
-        )
-      t)                                                              ; return t indicating that the match data was set
-    )
-  )
+    (if (>= (point) limit)              ; beyond limit
+        (progn
+          (goto-char original-point)    ; restore point
+          nil)                          ; return nil
 
-(defun init-highlight-beyond-fill-column ()
-  ""
-  (let (
- (modelist highlight-beyond-fill-column-in-modes)
- mode
- )
-    (while modelist
-      (setq mode (intern (car modelist)))
-      (if (and mode
-        (functionp mode))
-   (font-lock-add-keywords mode
-      '(
-        (find-after-fill-column 0 highlight-beyond-fill-column-face prepend)
-        )
-      )
- )
-      (setq modelist (cdr modelist))
-      )
-    )
-  )
+      (set-match-data (list (point-marker) ; set match data
+                            (progn
+                              (end-of-line)
+                              (point-marker))))
+      ;; return t indicating that the match data was set
+      t)))
 
-(add-hook 'after-init-hook 'init-highlight-beyond-fill-column)
+;;;###autoload
+(defun highlight-beyond-fill-column ()
+  "Setup this buffer to highlight beyond the `fill-column'."
+  (interactive)
+  (font-lock-add-keywords
+   nil
+   '((highlight-beyond-fill-column-lock 0 'highlight-beyond-fill-column-face
+                                        prepend))))
 
 (provide 'highlight-beyond-fill-column)
+
+;;; highlight-beyond-fill-column.el ends here
emacs-goodies-el-35.8ubuntu2/debian/patches/51_edit-env_copy-list.diff0000775000000000000000000000260012230377266022542 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 51_edit-env_copy-list.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/emacs-goodies-el/edit-env.el emacs-goodies-el/elisp/emacs-goodies-el/edit-env.el
--- emacs-goodies-el~/elisp/emacs-goodies-el/edit-env.el	2006-02-02 22:21:32.000000000 -0500
+++ emacs-goodies-el/elisp/emacs-goodies-el/edit-env.el	2006-02-02 22:22:38.000000000 -0500
@@ -111,6 +111,16 @@
 	       (list (widget-get widget 'environment-variable-name)
 		     widget)))
   
+;; Local copy from `copy-list' from cl.el  (PSG, Closes #340735)
+(defun edit-env-copy-list (list)
+  "Return a copy of a list, which may be a dotted list.
+The elements of the list are not copied, just the list structure itself."
+  (if (consp list)
+      (let ((res nil))
+	(while (consp list) (push (pop list) res))
+	(prog1 (nreverse res) (setcdr res list)))
+    (car list)))
+
 ;;;###autoload
 (defun edit-env ()
   "Display, edit, delete and add environment variables."
@@ -132,7 +142,7 @@
 	(val nil)
 	(longest-var 0)
 	(current-widget nil))
-    (setq edit-env-ls (copy-list process-environment))
+    (setq edit-env-ls (edit-env-copy-list process-environment))
     (setq edit-env-ls (sort edit-env-ls (lambda (a b) (string-lessp a b))))
 
     (widget-create 'push-button
emacs-goodies-el-35.8ubuntu2/debian/patches/52_gnus-pers.diff0000775000000000000000000000275312230377267020762 0ustar  #!/bin/sh -e
## 52_gnus-pers.dpatch by Elias Oltmanns 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Verify gnus-newsgroup-name is set before using it (See bug #384402)

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el	2004-08-16 20:49:16.000000000 -0400
+++ emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el	2004-08-16 20:51:59.000000000 -0400
@@ -868,7 +868,8 @@
 	     (retval (nthcdr 2 split))
 	     partial regexp)
 	;; Check to see if it's a "gnus-newsgroup-name" split
-	(if (equal ",gnus-newsgroup-name" (cdr (assq field gnus-personality-split-abbrev-alist)))
+	(if (and gnus-newsgroup-name
+		 (equal ",gnus-newsgroup-name" (cdr (assq field gnus-personality-split-abbrev-alist))))
 	    (let ((groupname gnus-newsgroup-name))
 	      (if (string-match value groupname)
 		  retval))
emacs-goodies-el-35.8ubuntu2/debian/patches/50_todoo_bug220718.diff0000775000000000000000000000402212230377266021470 0ustar  #!/bin/sh -e
## 50_todoo_bug220718.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Fix XEmacs keybindings (bug #220718)

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/todoo.el emacs-goodies-el/elisp/emacs-goodies-el/todoo.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/todoo.el	2003-10-07 19:18:28.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/todoo.el	2003-11-17 15:47:07.000000000 -0500
@@ -201,10 +201,17 @@
     (define-key map "\C-c\C-n" 'outline-next-visible-heading)
     (define-key map "\C-c\M-p" 'todoo-raise-item)
     (define-key map "\C-c\M-n" 'todoo-lower-item)
-    (define-key map [C-up] 'outline-previous-visible-heading)
-    (define-key map [C-down] 'outline-next-visible-heading)
-    (define-key map [C-S-up] 'todoo-raise-item)
-    (define-key map [C-S-down] 'todoo-lower-item)
+    (cond
+     ((string-match "XEmacs\\|Lucid" emacs-version)
+      (define-key map '(control up) 'outline-previous-visible-heading)
+      (define-key map '(control down) 'outline-next-visible-heading)
+      (define-key map '(control shift up) 'todoo-raise-item)
+      (define-key map '(control shift down) 'todoo-lower-item))
+     (t
+      (define-key map [C-up] 'outline-previous-visible-heading)
+      (define-key map [C-down] 'outline-next-visible-heading)
+      (define-key map [C-S-up] 'todoo-raise-item)
+      (define-key map [C-S-down] 'todoo-lower-item)))
     (setq todoo-mode-map map)))
 
 ;; Menu
emacs-goodies-el-35.8ubuntu2/debian/patches/50_coffee_no-autoload.diff0000775000000000000000000000233712230377266022563 0ustar  #!/bin/sh -e
## 50_coffee_no-autoload.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/coffee.el emacs-goodies-el/elisp/emacs-goodies-el/coffee.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/coffee.el	2004-01-15 16:22:57.000000000 -0500
+++ emacs-goodies-el/elisp/emacs-goodies-el/coffee.el	2004-01-15 16:25:46.000000000 -0500
@@ -69,7 +69,6 @@
     ("Sweetener" . ,coffee-sweetener-types)
     ("Alcohol"   . ,coffee-alcohol-types)))
 
-;;;###autoload
 (defun coffee ()
   "Submit a BREW request to an RFC2324-compliant coffee device"
   (interactive)
emacs-goodies-el-35.8ubuntu2/debian/patches/52_todoo_bug414781.diff0000775000000000000000000000271012230377266021501 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 52_todoo_bug414781.dpatch by  
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/emacs-goodies-el/todoo.el emacs-goodies-el/elisp/emacs-goodies-el/todoo.el
--- emacs-goodies-el~/elisp/emacs-goodies-el/todoo.el	2007-05-14 19:17:52.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/todoo.el	2007-05-14 19:20:51.000000000 -0400
@@ -57,6 +57,11 @@
 
 ;;; ChangeLog:
 
+;; 2007-05-14 Peter S Galbraith 
+;;  Comment out clobbering of outline-mode-menu-bar-map key entries.
+;;  This is far too aggressive.  A much better fix would be to undefine the
+;;  keys for todoo-mode-map.  Thanks to Simon Pepping (Closes #144781).
+
 ;; 2004-11-24 Peter S Galbraith 
 ;;  Debian bug 267637 fix: changes to outline-regexp should be buffer-local.
 ;;  Thanks to Daniel Skarda <0rfelyus@hobitin.ucw.cz> for pointing it out.
@@ -524,9 +529,9 @@
 
   (outline-minor-mode 1)
 
-  (define-key outline-mode-menu-bar-map [headings] 'undefined)
-  (define-key outline-mode-menu-bar-map [hide] 'undefined)
-  (define-key outline-mode-menu-bar-map [show] 'undefined)
+  ;;(define-key outline-mode-menu-bar-map [headings] 'undefined)
+  ;;(define-key outline-mode-menu-bar-map [hide] 'undefined)
+  ;;(define-key outline-mode-menu-bar-map [show] 'undefined)
 
   (if todoo-collapse-items
       (hide-body))
emacs-goodies-el-35.8ubuntu2/debian/patches/50_joc-toggle-buffer.diff0000775000000000000000000000737512230377266022342 0ustar  #!/bin/sh -e
## 50_joc-toggle-buffer.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Add joc- prefix.  $Revision: 1.1 $

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/rhogee/emacs/pkg-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/joc-toggle-buffer.el emacs-goodies-el/elisp/emacs-goodies-el/joc-toggle-buffer.el
--- /home/rhogee/emacs/pkg-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/joc-toggle-buffer.el	2004-04-20 14:44:06.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/joc-toggle-buffer.el	2004-04-20 14:46:48.000000000 -0400
@@ -1,4 +1,4 @@
-;;; @(#) toggle-buffer.el --- flips back and forth between two buffers
+;;; @(#) joc-toggle-buffer.el --- flips back and forth between two buffers
 
 ;; Copyright (C) 2001 by Joseph L. Casadonte Jr.
 
@@ -62,7 +62,7 @@
 ;;  Put this file on your Emacs-Lisp load path and add the following to your
 ;;  ~/.emacs startup file
 ;;
-;;     (require 'toggle-buffer)
+;;     (require 'joc-toggle-buffer)
 
 ;;; Usage:
 ;;
@@ -99,13 +99,18 @@
 ;;  Any comments, suggestions, bug reports or upgrade requests are welcome.
 ;;  Please send them to Joe Casadonte (emacs@northbound-train.com).
 ;;
-;;  This version of toggle-buffer was developed and tested with NTEmacs 20.5.1
+;;  This version of joc-toggle-buffer was developed and tested with NTEmacs 20.5.1
 ;;  and 2.7 under Windows NT 4.0 SP6 and Emacs 20.7.1 under Linux (RH7).
 ;;  Please, let me know if it works with other OS and versions of Emacs.
 
 ;;; Change Log:
 ;;
 ;;  see http://www.northbound-train.com/emacs/toggle-buffer.log
+;;
+;;  2003-11-23 Peter S Galbraith 
+;;   This version, distributed in the Debian package `emacs-goodies-el',
+;;   was renamed from toggle-buffer.el to joc-toggle-buffer.el.  The prefix
+;;   was also added to a few variables.
 
 ;;; **************************************************************************
 ;;; **************************************************************************
@@ -151,7 +156,7 @@
   :group 'joc-toggle-buffer)
 
 ;; ---------------------------------------------------------------------------
-(defcustom toggle-buffer-load-hook nil
+(defcustom joc-toggle-buffer-load-hook nil
   "Hook to run when package is loaded."
   :type 'hook
   :group 'joc-toggle-buffer)
@@ -181,10 +186,12 @@
 (defvar joc-toggle-buffer-last-buffer nil
   "Contains the name of the previous buffer.")
 
+;;;###autoload
 (defun joc-toggle-buffer ()
   "Switch to previous active buffer."
   (interactive)
-  (if (not (boundp 'joc-toggle-buffer-last-buffer))
+  (if (or (not (boundp 'joc-toggle-buffer-last-buffer))
+          (not joc-toggle-buffer-last-buffer))
 	  (error "No previous buffer to switch to (yet)"))
   (let ((buff (get-buffer joc-toggle-buffer-last-buffer)))
 	(if (not buff)
@@ -231,9 +238,8 @@
 ;;; **************************************************************************
 ;;; ***** we're done
 ;;; **************************************************************************
-(provide 'toggle-buffer)
-(run-hooks 'toggle-buffer-load-hook)
+(run-hooks 'joc-toggle-buffer-load-hook)
+
+(provide 'joc-toggle-buffer)
 
 ;;; toggle-buffer.el ends here
-;;; **************************************************************************
-;;;; *****  EOF  *****  EOF  *****  EOF  *****  EOF  *****  EOF  *************
emacs-goodies-el-35.8ubuntu2/debian/patches/50_joc-toggle-case.diff0000775000000000000000000001673312230377266022002 0ustar  #!/bin/sh -e
## 50_joc-toggle-case.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Rename and add joc- prefix.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
--- a/elisp/emacs-goodies-el/joc-toggle-case.el
+++ b/elisp/emacs-goodies-el/joc-toggle-case.el
@@ -28,7 +28,9 @@
 ;; Boston, MA 02111-1307, USA.
 ;;; **************************************************************************
 
-;;; Description:
+;;; Commentary:
+;; 
+;; Description:
 ;;
 ;;  This packages provides a sophisticated (over-engineered?) set of
 ;;  functions to toggle the case of the character under point, with
@@ -38,16 +40,16 @@
 ;;  character, allowing successive invocations to progress down the
 ;;  line.
 
-;;; Installation:
+;; Installation:
 ;;
 ;;  Put this file on your Emacs-Lisp load path and add the following to your
 ;;  ~/.emacs startup file
 ;;
-;;     (require 'toggle-case)
+;;     (require 'joc-toggle-case)
 ;;
 ;;  See below for key-binding suggestions.
 
-;;; Usage:
+;; Usage:
 ;;
 ;;  M-x `joc-toggle-case'
 ;;     Toggles the case of the character under point.  If called with
@@ -81,7 +83,7 @@
 ;;  M-x `joc-toggle-case-by-word-backwards'
 ;;     Toggles the case of all characters in the current region.
 
-;;; Customization:
+;; Customization:
 ;;
 ;;  M-x `joc-toggle-case-customize' to customize all package options.
 ;;
@@ -95,7 +97,7 @@
 ;;        is reversed, the semantics of this are reveresed as well
 ;;        (i.e. does it stop at the beginning of the line).
 
-;;; Keybinding examples:
+;; Keybinding examples:
 ;;
 ;;  This is what I have -- use it or not as you like.
 ;;
@@ -119,7 +121,7 @@
 ;;  Any comments, suggestions, bug reports or upgrade requests are welcome.
 ;;  Please send them to Joe Casadonte (emacs@northbound-train.com).
 ;;
-;;  This version of toggle-case was developed and tested with NTEmacs
+;;  This version of joc-toggle-case was developed and tested with NTEmacs
 ;;  2.7 under Windows NT 4.0 SP6 and Emacs 20.7.1 under Linux (RH7).
 ;;  Please, let me know if it works with other OS and versions of Emacs.
 
@@ -128,6 +130,14 @@
 ;;; **************************************************************************
 ;;; **************************************************************************
 ;;; **************************************************************************
+
+;;; History:
+;; 
+;;  2003-11-23 Peter S Galbraith 
+;;   This version, distributed in the Debian package `emacs-goodies-el',
+;;   was renamed from toggle-case.el to joc-toggle-case.el.  The prefix
+;;   was also added in the file where appropriate.
+
 ;;; Code:
 
 ;;; **************************************************************************
@@ -139,7 +149,7 @@
 
 ;; ---------------------------------------------------------------------------
 (defun joc-toggle-case-customize ()
-  "Customization of the group joc-toggle-case."
+  "Customization of the group `joc-toggle-case'."
   (interactive)
   (customize-group "joc-toggle-case"))
 
@@ -150,7 +160,7 @@
 stop at the end of the line, set to `nil' it will not (it
 will continue on to the next line).  If direction of toggle
 is reversed, the semantics of this are reveresed as well
-(i.e. does it stop at the beginning of the line)."
+\(i.e. does it stop at the beginning of the line)."
   :group 'joc-toggle-case
   :type 'boolean)
 
@@ -163,26 +173,27 @@
 
 ;; ---------------------------------------------------------------------------
 (defun joc-toggle-case-version-number ()
-  "Returns joc-toggle-case version number."
+  "Return `joc-toggle-case' version number."
   (string-match "[0123456789.]+" joc-toggle-case-version)
   (match-string 0 joc-toggle-case-version))
 
 ;; ---------------------------------------------------------------------------
 (defun joc-toggle-case-display-version ()
-  "Displays joc-toggle-case version."
+  "Displays `joc-toggle-case' version."
   (interactive)
   (message "joc-toggle-case version <%s>." (joc-toggle-case-version-number)))
 
 ;;; **************************************************************************
 ;;; ***** interactive functions
 ;;; **************************************************************************
+;;;###autoload
 (defun joc-toggle-case (prefix)
-  "Toggles the case of the character under point.  If called with
-a prefix argument, it toggles that many characters (see
-joc-toggle-case-stop-at-eol).  If the prefix is negative, the
-case of the character before point is toggled, and if called
-with a prefix argument, N characters before point will have
-their case toggled (see also joc-toggle-case-backwards)."
+  "Toggle the case of the character under point.
+If called with a PREFIX argument, it toggles that many
+characters (see joc-toggle-case-stop-at-eol).  If the prefix is
+negative, the case of the character before point is toggled, and
+if called with a prefix argument, N characters before point will
+have their case toggled (see also joc-toggle-case-backwards)."
 
   (interactive "*p")
 
@@ -207,14 +218,16 @@
 		  (setq lcv count)))))
 
 ;; ---------------------------------------------------------------------------
+;;;###autoload
 (defun joc-toggle-case-backwards (prefix)
-  "Convenience function to toggle case of character preceeding
-point.  This is the same as calling joc-toggle-case with a
-negative prefix (and is in fact implemented that way)."
+  "Convenience function to toggle case of character preceeding point.
+This is the same as calling joc-toggle-case with a negative
+prefix (and is in fact implemented that way)."
   (interactive "*p")
   (joc-toggle-case (- prefix)))
 
 ;; ---------------------------------------------------------------------------
+;;;###autoload
 (defun joc-toggle-case-by-word (prefix)
   "Similar to joc-toggle-case except that the count (supplied by
 the prefix argument) is of the number of words, not letters, to
@@ -238,14 +251,16 @@
 	(joc-toggle-case (- end start))))
 
 ;; ---------------------------------------------------------------------------
+;;;###autoload
 (defun joc-toggle-case-by-word-backwards (prefix)
-  "Convenience function to toggle case by word, backwards.  This
-is the same as calling joc-toggle-case-by-word with a
+  "Convenience function to toggle case by word, backwards.
+This is the same as calling joc-toggle-case-by-word with a
 negative prefix (and is in fact implemented that way)."
   (interactive "*p")
   (joc-toggle-case-by-word (- prefix)))
 
 ;; ---------------------------------------------------------------------------
+;;;###autoload
 (defun joc-toggle-case-by-region (start end)
   "Toggles the case of all characters in the current region."
   (interactive "*r")
@@ -310,8 +325,6 @@
 ;;; **************************************************************************
 ;;; ***** we're done
 ;;; **************************************************************************
-(provide 'toggle-case)
+(provide 'joc-toggle-case)
 
-;; toggle-case.el ends here!
-;;; **************************************************************************
-;;;; *****  EOF  *****  EOF  *****  EOF  *****  EOF  *****  EOF  *************
+;;; joc-toggle-case.el ends here
emacs-goodies-el-35.8ubuntu2/debian/patches/50_setnu.diff0000775000000000000000000002306512230377266020171 0ustar  #!/bin/sh -e
## 50_setnu.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: setnu defface and checkdoc cleanup.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/setnu.el emacs-goodies-el/elisp/emacs-goodies-el/setnu.el
--- /home/psg/emacs/emacs-goodies-el/emacs-goodies-el/elisp/emacs-goodies-el/setnu.el	2003-10-15 20:54:31.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/setnu.el	2003-10-14 21:37:45.000000000 -0400
@@ -1,32 +1,42 @@
-;;; vi-style line number mode for Emacs
-;;; (requires Emacs 19.29 or later, or XEmacs 19.14 or later)
-;;; Copyright (C) 1994, 1995, 1997 Kyle E. Jones
-;;;
-;;; 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 2, 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.
-;;;
-;;; A copy of the GNU General Public License can be obtained from this
-;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
-;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
-;;; 02139, USA.
-;;;
-;;; Send bug reports to kyle@wonderworks.com
+;;; setnu.el --- vi-style line number mode for Emacs
+;;
+;; (requires Emacs 19.29 or later, or XEmacs 19.14 or later)
+;; Copyright (C) 1994, 1995, 1997 Kyle E. Jones
+;;
+;; 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 2, 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.
+;;
+;; A copy of the GNU General Public License can be obtained from this
+;; program's author (send electronic mail to kyle@uunet.uu.net) or from
+;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+;; 02139, USA.
+
+;;; Commentary:
+;;
+;; Send bug reports to kyle@wonderworks.com
 ;;
 ;; M-x setnu-mode toggles the line number mode on and off.
 ;;
-;; turn-on-setnu-mode is useful for adding to a major-mode hook
-;; variable.
+;; turn-on-setnu-mode is useful for adding to a major-mode hook variable.
 ;; Example:
 ;;     (add-hook 'text-mode-hook 'turn-on-setnu-mode)
-;; to automatically turn on line numbering when enterting text-mode."
+;;  to automatically turn on line numbering when enterting text-mode."
 
+;;; History:
+;; 
+;; 2003-10-13 Peter S Galbraith 
+;;  - made checkdoc changes (but it's still not happy).
+;;  - created settnu defgroup and created defface setnu-line-number-face.
+;;  - added atoload tags.
+
+;;; Code:
 (provide 'setnu)
 
 (defconst setnu-running-under-xemacs
@@ -34,20 +44,20 @@
       (string-match "Lucid" emacs-version)))
 
 (defconst setnu-mode-version "1.06"
-  "Version number for this release of setnu-mode.")
+  "Version number for this release of `setnu-mode'.")
 
 (defvar setnu-mode nil
-  "Non-nil if setnu-mode is active in the current buffer.")
+  "Non-nil if `setnu-mode' is active in the current buffer.")
 (make-variable-buffer-local 'setnu-mode)
 
 (defvar setnu-start-extent nil
-  "First extent of a chain of extents used by setnu-mode.
+  "First extent of a chain of extents used by `setnu-mode'.
 Each line has its own extent.  Each line extent has a
 `setnu-next-extent' property that points to the next extent in
 the chain, which is the extent for the next line in the buffer.
 There is also a `setnu-prev-extent' that points at the previous
 extent in the chain.  To distinguish them from other extents the
-setnu-mode extents all have a non-nil `setnu' property.")
+`setnu-mode' extents all have a non-nil `setnu' property.")
 (make-variable-buffer-local 'setnu-start-extent)
 
 (defvar setnu-glyph-obarray (make-vector 401 0)
@@ -66,14 +76,21 @@
 `format' will be called with this string and one other argument
 which will be an integer, the line number.")
 
-(defvar setnu-line-number-face 'bold
-  "*Face used to display the line numbers.
-Currently this works for XEmacs 19.12 and later versions only.")
+(defvar setnu-line-number-face 'setnu-line-number-face
+  "*Face used to display the line numbers.")
+
+(defgroup setnu nil
+  "vi-style line number mode for Emacs.")
+
+(defface setnu-line-number-face '((t (:bold t)))
+  "*Face used to display the line numbers."
+  :group 'setnu)
 
+;;;###autoload
 (defun setnu-mode (&optional arg)
-  "Toggle setnu-mode.
-With prefix argument, turn setnu-mode on if argument is positive.
-When setnu-mode is enabled, a line number will appear at the left
+  "Toggle `setnu-mode'.
+With prefix argument ARG, turn `setnu-mode' on if argument is positive.
+When `setnu-mode' is enabled, a line number will appear at the left
 margin of each line."
   (interactive "P")
   (let ((oldmode (not (not setnu-mode)))
@@ -85,12 +102,13 @@
 	    (setnu-mode-on)
 	  (setnu-mode-off)))))
 
+;;;###autoload
 (defun turn-on-setnu-mode ()
-  "Turn on setnu-mode.
-Useful for adding to a major-mode hook variable.
+  "Turn on `setnu-mode'.
+Useful for adding to a `major-mode' hook variable.
 Example:
     (add-hook 'text-mode-hook 'turn-on-setnu-mode)
-to automatically turn on line numbering when enterting text-mode."
+to automatically turn on line numbering when enterting `text-mode'."
   (setnu-mode 1))
 
 ;;; Internal functions
@@ -148,8 +166,8 @@
 	 (put-text-property 0 (length g) 'face face g))))
 
 (defun setnu-mode-off ()
-  "Internal shutdown of setnu-mode.
-Deletes the extents associated with setnu-mode."
+  "Internal shutdown of `setnu-mode'.
+Deletes the extents associated with `setnu-mode'."
   (if (and setnu-running-under-xemacs
 	   (fboundp 'remove-specifier))
       (remove-specifier left-margin-width (current-buffer)))
@@ -163,11 +181,13 @@
 	(setq setnu-start-extent nil))))
 
 (defun setnu-mode-on ()
-  "Internal startup of setnu-mode.
-Sets up the extents associated with setnu-mode."
+  "Internal startup of `setnu-mode'.
+Sets up the extents associated with `setnu-mode'."
   (if (and setnu-running-under-xemacs
 	   (fboundp 'set-specifier))
       (set-specifier left-margin-width 6 (current-buffer)))
+  (add-hook 'before-change-functions 'setnu-before-change-function)
+  (add-hook 'after-change-functions 'setnu-after-change-function)
   (let ((done nil)
 	(curr-e nil)
 	(n 1)
@@ -196,9 +216,9 @@
       (store-match-data match-data))))
 
 (defun setnu-before-change-function (start end)
-  "Before change function for setnu-mode.
+  "Before change function for `setnu-mode'.
 Notices when a delete is about to delete some lines and adjusts
-the line number extents accordingly."
+the line number extents accordingly (betwee START and END)."
   (if (or (not setnu-mode) (= start end))
       () ;; not in setnu-mode or this is an insertion
     (let ((inhibit-quit t)
@@ -252,9 +272,12 @@
 	(store-match-data match-data)))))
 
 (defun setnu-after-change-function (start end length)
-  "After change function for setnu-mode.
+  "After change function for `setnu-mode'.
 Notices when an insert has added some lines and adjusts
-the line number extents accordingly."
+the line number extents accordingly.
+Three arguments are passed to an `after-change-function': the positions of
+the START and END of the range of changed text,
+and the LENGTH in bytes of the pre-change text replaced by that range."
   (if (or (not setnu-mode) (= start end))
       () ; not in setnu-mode or this is a deletion
     (let ((inhibit-quit t)
@@ -331,7 +354,8 @@
 	g ))))
 
 (defun setnu-make-setnu-extent (beg end)
-  "Create an extent and set some properties that all setnu extents have."
+  "Create an extent and set some properties that all setnu extents have.
+Extent is between BEG and END."
   (let ((e (setnu-make-extent beg end)))
     (setnu-set-extent-property e 'setnu t)
 ;;    (setnu-set-extent-property e 'begin-glyph-layout 'outside-margin)
@@ -389,11 +413,12 @@
 				       e
 				     nil)))
 		       buf pos pos)))
-       (t (error "can't find overlays-in, overlays-at, or map-extents!")))
+       (t (error "Can't find overlays-in, overlays-at, or map-extents!")))
 
 (defun setnu-extent-at-create (pos buf)
-  "Like `setnu-extent-at' except if an extent isn't found, then
-it is created based on where the extent failed to be found."
+  "Like `setnu-extent-at' for position POS in buffer BUF.
+If an extent isn't found, then it is created based on where the extent failed
+to be found."
   (let ((e (setnu-extent-at pos buf)) ee beg numstr)
     (if e
 	e
@@ -444,5 +469,6 @@
 	       (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr))
 	       e ))))))
 
-(add-hook 'before-change-functions 'setnu-before-change-function)
-(add-hook 'after-change-functions 'setnu-after-change-function)
+(provide 'setnu)
+
+;;; setnu.el ends here
emacs-goodies-el-35.8ubuntu2/debian/patches/50_dict_bug301293.diff0000775000000000000000000000324712230377266021275 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 50_dict_bug301293.dpatch by  
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/emacs-goodies-el/dict.el emacs-goodies-el/elisp/emacs-goodies-el/dict.el
--- emacs-goodies-el~/elisp/emacs-goodies-el/dict.el	2009-09-03 21:50:58.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/dict.el	2009-09-03 21:55:19.000000000 -0400
@@ -480,14 +480,29 @@
 	 ((string-match "exited abnormally with code" msg)
 	  (message msg)))))))
 
+;;(defsubst dict-default-dict-entry ()
+;;  "Make a guess at a default dict entry.
+;;This guess is based on the text surrounding the cursor."
+;;  (let (word)
+;;    (save-excursion
+;;      (setq word (current-word))
+;;      (if (string-match "[._]+$" word)
+;;	  (setq word (substring word 0 (match-beginning 0))))
+;;      word)))
+
+;; Debian Bug 301293 reported and patched by Jorgen Schaefer 
+;; `current-word' can return nil, which causes this function to
+;; error out in the `string-match'. Also, `save-excursion' doesn't
+;; do anything here.
+;;
+;; This should be written as:
 (defsubst dict-default-dict-entry ()
-  "Make a guess at a default dict entry.
+  "Make a guess at the default dict entry.
 This guess is based on the text surrounding the cursor."
-  (let (word)
-    (save-excursion
-      (setq word (current-word))
-      (if (string-match "[._]+$" word)
-	  (setq word (substring word 0 (match-beginning 0))))
+  (let ((word (or (current-word)
+                  "")))
+    (if (string-match "[._]+$" word)
+        (substring word 0 (match-beginning 0))
       word)))
 
 ;;;;
emacs-goodies-el-35.8ubuntu2/debian/patches/51_diminishSamuelBronson.diff0000664000000000000000000000627712230377266023353 0ustar  --- a/elisp/emacs-goodies-el/diminish.el
+++ b/elisp/emacs-goodies-el/diminish.el
@@ -8,7 +8,7 @@
 ;; Version: 0.45, 18 Jun 2003
 ;; Keywords: extensions, diminish, minor, codeprose
 
-;; This file is part of GNU Emacs.
+;; This file is NOT part of GNU Emacs.
 
 ;; 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
@@ -123,6 +123,17 @@
 ;;    files perhaps, and then add an eval-after-load?  Seems like a kludge
 ;;    because it relies on outside information remaining constant, but it
 ;;    would help.
+;;
+;; 2011-01-12 Samuel J. J. Bronson 
+;;
+;;  - Make `diminished-minor-modes' (probably) Just Work.  It should
+;;    no longer be necessary ot do anything special in elisp; instead
+;;    of trying to minimize computation, we simply redo everything
+;;    after any elisp gets loaded.  (If this turns out to be too slow,
+;;    there are some relatively straightforward improvements that
+;;    could be made without having to rely on foreknowledge of what
+;;    gets defined where.  For example, by keeping track of "pending"
+;;    diminished modes and only trying to diminish those.)
 
 ;;; Code:
 
@@ -252,7 +263,7 @@
   (if (eq mode 'diminished-modes)
       (let ((diminished-modes diminished-mode-alist))
         (while diminished-modes
-          (diminish-undo (caar diminished-modes))
+          (diminish-undo (caar diminished-modes) annotate-flag)
           (callf cdr diminished-modes)))
     (let ((minor      (assq mode      minor-mode-alist))
           (diminished (assq mode diminished-mode-alist)))
@@ -321,10 +332,28 @@
 ;; in line with the ducks and geese at the espresso counter, gazing placidly
 ;; out on the world through loon-red eyes, thinking secret thoughts.
 
+;;;###autoload
+(defun diminish-maybe-refresh ()
+  "Should redo `diminish'ing only if something has changed.
+Right now, do it regardless and hope this isn't too slow."
+  (interactive)
+  (diminish-undo 'diminished-modes t)
+  (mapcar #'(lambda (x) (diminish (car x) (cdr x) t))
+	  diminished-minor-modes))
+
+(defun diminish-oneshot-post-command-hook ()
+  (diminish-maybe-refresh)
+  (remove-hook 'post-command-hook 'diminish-oneshot-post-command-hook))
+
+(defun diminish-after-load-hook (file)
+  (add-hook 'post-command-hook 'diminish-oneshot-post-command-hook))
+(add-hook 'after-load-functions 'diminish-after-load-hook)
+
 (defgroup diminish nil
   "Diminished modes are minor modes with no modeline display."
   :group 'convenience)
 
+;;;###autoload
 (defcustom diminished-minor-modes nil
   "List of minor modes to diminish and their mode line display strings.
 The display string can be the empty string if you want the name of the mode
@@ -340,11 +369,9 @@
 		:value-type (string :tag "Title"))
   :options (mapcar 'car minor-mode-alist)
   :set (lambda (symbol value)
-         (if (and (boundp 'diminished-minor-modes) diminished-minor-modes)
-             (mapcar 
-              (lambda (x) (diminish-undo (car x) t)) diminished-minor-modes))
          (set-default symbol value)
-         (mapcar (lambda (x) (diminish (car x) (cdr x) t)) value)))
+	 (diminish-maybe-refresh))
+  :require 'diminish)
 
 (provide 'diminish)
 
emacs-goodies-el-35.8ubuntu2/debian/patches/50_gnus-BTS.diff0000775000000000000000000001473312230377266020437 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 50_gnus-BTS.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad --exclude=CVS --exclude=.svn ./elisp/debian-el/gnus-BTS.el /tmp/dpep-work.XVQhTr/emacs-goodies-el/elisp/debian-el/gnus-BTS.el
--- ./elisp/debian-el/gnus-BTS.el	2005-09-15 21:38:07.000000000 -0400
+++ /tmp/dpep-work.XVQhTr/emacs-goodies-el/elisp/debian-el/gnus-BTS.el	2005-09-19 18:54:07.000000000 -0400
@@ -33,42 +33,74 @@
 ;; references to the Bug Tracking system in them. It expects to see
 ;; Bug references in the form of (for example): "#48273", "closes:
 ;; 238742" or similar.
+;;
+;; Use `M-x' `gnus-dbts-browse-debpkg-or-bug' over the bug number.
 
+;;; Change log:
+;; 2005-08-20  Jari Aalto  
+;; 
+;; 	* gnus-BTS.el:
+;; 	(top level): Changed all variable and function names to use common
+;; 	prefix `gnus-dbts-'. This makes package namespace clean. Converted
+;; 	all lambda forms to real functions. Cleaned up
+;; 	`gnus-select-article-hook' setting.
+;; 	Changed all 'setq' to 'defvar'.
+;; 	(gnus-dbts-gnus-install): New.
+;; 	(gnus-dbts-gnus-select-article-hook): New.
+;; 	(gnus-dbts-buttonize): New.
+;; 	(eval-after-load): New. Install at point when Gnus is being loaded.
+;; 
+;; 2005-09-19 Peter S Galbraith 
+;;
+;;      Minor bug fix: gnus-dbts-gnus-install missing brackets.
+;;      
 ;;; Code:
 
 
-(setq anti-bug-special-keywords "reassign\\|merge")
-(setq anti-bug-keywords (concat
-			 "tags\\|severity\\|retitle\\|close\\|closes:\\|Merged\\|reopen\\|Bug\\|"
-			 anti-bug-special-keywords))
+;; gnus-dbts = Gnus inerface to Debian Bug Tracking System
 
-(setq anti-bug-prefix " *#?\\|Bugs?\\|#")
-(setq anti-bug-number " *\\([0-9]+\\)")
-(setq anti-bug-special " +\\([0-9]+\\|[-.A-Za-z0-9]+\\)")
+(autoload 'thing-at-point "thingatpt")
 
-(setq anti-gnus-debian-bug-regexp (concat
-				   "\\("
-				   "\\("
-				   anti-bug-keywords
-				   "\\)"
-				   anti-bug-prefix
-				   "\\)"
-				   anti-bug-number))
+(defvar gnus-dbts-in-debian-group-p nil)
 
-(setq anti-gnus-debian-reassign-or-merge-regexp
-      (concat
-       "\\("
-       anti-bug-special-keywords
-       "\\)"
-       anti-bug-number
-       anti-bug-special))
+(defvar gnus-dbts-in-debian-devel-announce-group-p nil)
 
-(setq anti-gnus-debian-reassign-regexp "reassigned from package `\\([^']*\\)' to `\\([^']*\\)'")
-(setq anti-gnus-debian-bug-BTS-regexp "^ *\\([0-9]+\\)")
+(defvar gnus-dbts-bug-special-keywords "reassign\\|merge")
 
-(defun anti-browse-debpkg-or-bug (thing)
+(defvar gnus-dbts-bug-keywords
+  (concat
+   "tags\\|severity\\|retitle\\|close\\|closes:\\|Merged\\|reopen\\|Bug\\|"
+   gnus-dbts-bug-special-keywords))
+
+(defvar gnus-dbts-bug-prefix " *#?\\|Bugs?\\|#")
+(defvar gnus-dbts-bug-number " *\\([0-9]+\\)")
+(defvar gnus-dbts-bug-special " +\\([0-9]+\\|[-.A-Za-z0-9]+\\)")
+
+(defvar gnus-dbts-debian-bug-regexp
+  (concat
+   "\\("
+   "\\("
+   gnus-dbts-bug-keywords
+   "\\)"
+   gnus-dbts-bug-prefix
+   "\\)"
+   gnus-dbts-bug-number))
+
+(defvar gnus-dbts-debian-reassign-or-merge-regexp
+  (concat
+   "\\("
+   gnus-dbts-bug-special-keywords
+   "\\)"
+   gnus-dbts-bug-number
+   gnus-dbts-bug-special))
+
+(defvar gnus-dbts-debian-reassign-regexp
+  "reassigned from package `\\([^']*\\)' to `\\([^']*\\)'")
+
+(defvar gnus-dbts-debian-bug-regexp "^ *\\([0-9]+\\)")
+
+(defun gnus-dbts-browse-debpkg-or-bug (thing)
   (interactive "i")
-  (require 'thingatpt)
   (let* ((the-thing (if (null thing)
 			(thing-at-point 'sexp)
 		      thing))
@@ -80,45 +112,48 @@
 			   the-thing))
 	 (url (if bugp
 		  "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug="
-		"http://cgi.debian.org/cgi-bin/search_packages.pl?&searchon=names&version=all&release=all&keywords=")))
+		(concat
+		 "http://cgi.debian.org/cgi-bin/search_packages.pl"
+		 "?&searchon=names&version=all&release=all&keywords="))))
     (browse-url (concat url bug-or-feature))))
 
-(defvar in-debian-group-p nil)
-(add-hook 'gnus-select-article-hook
-	  (lambda ()
-	    (setq in-debian-group-p (string-match "debian"
-						  (gnus-group-real-name
-						   gnus-newsgroup-name)))))
-
-(defvar in-debian-devel-announce-group-p nil)
-(add-hook 'gnus-select-article-hook
-	  (lambda ()
-	    (setq in-debian-devel-announce-group-p
-		  (string-match "debian.devel.announce"
-				(gnus-group-real-name
-				 gnus-newsgroup-name)))))
-
-(defun anti-buttonize-debian (regexp num predicate)
+(defun gnus-dbts-buttonize-debian (regexp num predicate)
   (add-to-list 'gnus-button-alist
 	       (list regexp
 		     num
 		     predicate
-		     'anti-browse-debpkg-or-bug
+		     'gnus-dbts-browse-debpkg-or-bug
 		     num)))
 
-(add-hook
- 'gnus-article-mode-hook    ; only run once, as soon as the article buffer has been created.
- (lambda ()
-   (anti-buttonize-debian anti-gnus-debian-bug-regexp 3
-			  'in-debian-group-p)
-   (anti-buttonize-debian anti-gnus-debian-reassign-or-merge-regexp 3
-			  'in-debian-group-p)
-   (anti-buttonize-debian anti-gnus-debian-bug-BTS-regexp 1
-			  'in-debian-devel-announce-group-p)
-   
-   (anti-buttonize-debian anti-gnus-debian-reassign-regexp 1
-			  'in-debian-group-p)
-   (anti-buttonize-debian anti-gnus-debian-reassign-regexp 2
-			  'in-debian-group-p)))
+(defun gnus-dbts-buttonize ()
+  (gnus-dbts-buttonize-debian gnus-dbts-debian-bug-regexp 3
+			      'gnus-dbts-in-debian-group-p)
+  (gnus-dbts-buttonize-debian gnus-dbts-debian-reassign-or-merge-regexp 3
+			      'gnus-dbts-in-debian-group-p)
+  (gnus-dbts-buttonize-debian gnus-dbts-debian-bug-regexp 1
+			      'gnus-dbts-in-debian-devel-announce-group-p)
+  (gnus-dbts-buttonize-debian gnus-dbts-debian-reassign-regexp 1
+			      'gnus-dbts-in-debian-group-p)
+  (gnus-dbts-buttonize-debian gnus-dbts-debian-reassign-regexp 2
+				 'gnus-dbts-in-debian-group-p))
+
+(defun gnus-dbts-gnus-select-article-hook ()
+  (setq gnus-dbts-in-debian-group-p
+	(string-match "debian"
+		      (gnus-group-real-name
+		       gnus-newsgroup-name)))
+  (setq gnus-dbts-in-debian-devel-announce-group-p
+	(string-match "debian.devel.announce"
+		      (gnus-group-real-name
+		       gnus-newsgroup-name))))
+
+(defun gnus-dbts-gnus-install ()
+  (add-hook 'gnus-select-article-hook 'gnus-dbts-gnus-select-article-hook)
+   ;; only run once, as soon as the article buffer has been created.
+  (add-hook 'gnus-article-mode-hook 'gnus-dbts-buttonize))
+
+(eval-after-load "gnus" '(progn (gnus-dbts-gnus-install)))
 
 (provide 'gnus-BTS)
+
+;; End of file
emacs-goodies-el-35.8ubuntu2/debian/patches/50_color-theme_custom.diff0000664000000000000000000000242012230377266022630 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 50_color-theme_custom.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
--- a/elisp/emacs-goodies-el/color-theme.el
+++ b/elisp/emacs-goodies-el/color-theme.el
@@ -221,7 +221,9 @@
 (defcustom color-theme-libraries (directory-files 
                                   (concat 
                                    (file-name-directory (locate-library "color-theme"))
-                                   "/themes") t "^color-theme")
+;;; Debian doesn't use the "/themes" subdirectory and uses the prefix
+;;; "^color-theme-" instead of simply "^color-theme" to accomodate this.
+                                   "") t "^color-theme-")
   "A list of files, which will be loaded in color-theme-initialize depending
 on `color-theme-load-all-themes' value. 
 This allows a user to prune the default color-themes (which can take a while
--- a/elisp/emacs-goodies-el/color-theme-library.el
+++ b/elisp/emacs-goodies-el/color-theme-library.el
@@ -30,6 +30,8 @@
 (eval-when-compile
   (require 'color-theme))
 
+(require 'info)
+
 (defun color-theme-gnome ()
   "Wheat on darkslategrey scheme.
 From one version of Emacs in RH6 and Gnome, modified by Jonadab."
emacs-goodies-el-35.8ubuntu2/debian/patches/51_session_autoload.diff0000664000000000000000000000200612230377266022374 0ustar  #!/bin/sh -e
## 51_session_autoload.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Remove a defmacro autoload tag.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
--- a/elisp/emacs-goodies-el/session.el
+++ b/elisp/emacs-goodies-el/session.el
@@ -1717,7 +1717,6 @@
   :require 'session
   :set 'session-initialize-and-set)
 
-;;;###autoload
 (defun session-initialize ()
   "Initialize package session and read previous session file.
 Setup hooks and load `session-save-file', see variable `session-initialize'.  At
emacs-goodies-el-35.8ubuntu2/debian/patches/51_gnus-BTS_bug363161.diff0000775000000000000000000000304612230377266021754 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 51_gnus-BTS_bug363161.dpatch by  
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/debian-el/gnus-BTS.el emacs-goodies-el/elisp/debian-el/gnus-BTS.el
--- emacs-goodies-el~/elisp/debian-el/gnus-BTS.el	2007-09-18 21:19:47.000000000 -0400
+++ emacs-goodies-el/elisp/debian-el/gnus-BTS.el	2007-09-18 21:20:47.000000000 -0400
@@ -53,6 +53,11 @@
 ;; 2005-09-19 Peter S Galbraith 
 ;;
 ;;      Minor bug fix: gnus-dbts-gnus-install missing brackets.
+;;
+;; 2007-09-17 Peter S Galbraith 
+;;
+;;      Wrong regexp part of gnus-dbts-debian-bug-regexp called by
+;;      gnus-dbts-buttonize-debian (Closes #363161, #442438).
 ;;      
 ;;; Code:
 
@@ -97,8 +102,6 @@
 (defvar gnus-dbts-debian-reassign-regexp
   "reassigned from package `\\([^']*\\)' to `\\([^']*\\)'")
 
-(defvar gnus-dbts-debian-bug-regexp "^ *\\([0-9]+\\)")
-
 (defun gnus-dbts-browse-debpkg-or-bug (thing)
   (interactive "i")
   (let* ((the-thing (if (null thing)
@@ -130,7 +133,7 @@
 			      'gnus-dbts-in-debian-group-p)
   (gnus-dbts-buttonize-debian gnus-dbts-debian-reassign-or-merge-regexp 3
 			      'gnus-dbts-in-debian-group-p)
-  (gnus-dbts-buttonize-debian gnus-dbts-debian-bug-regexp 1
+  (gnus-dbts-buttonize-debian gnus-dbts-debian-bug-regexp 3
 			      'gnus-dbts-in-debian-devel-announce-group-p)
   (gnus-dbts-buttonize-debian gnus-dbts-debian-reassign-regexp 1
 			      'gnus-dbts-in-debian-group-p)
emacs-goodies-el-35.8ubuntu2/debian/patches/55_gnus-pers_bug263371.diff0000775000000000000000000000266212230377266022306 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 55_gnus-pers_bug263371.dpatch by  
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/gnus-bonus-el/gnus-pers.el emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el
--- emacs-goodies-el~/elisp/gnus-bonus-el/gnus-pers.el	2007-09-18 21:34:19.000000000 -0400
+++ emacs-goodies-el/elisp/gnus-bonus-el/gnus-pers.el	2007-09-18 21:35:32.000000000 -0400
@@ -73,6 +73,13 @@
 ;; Reported and fixed Debian bug #384209
 ;; `Cc-fix feature in gnus-pers is horribly broken'
 
+;; 1.4  Bruce Stephens  and
+;;      Elias Oltmanns 
+;;
+;; When in a group which has a personality setting (I set a general one in
+;; my top-level topic) gnus-personality-choose doesn't allow me to change
+;; personality. (Closes #263371)
+
 ;Todo:
 ; + redo x-tra headers to be a repeat list of two parts, header name
 ; and header data. Then allow either to be a function.
@@ -380,9 +387,8 @@
 
 
   ; if group has a personality parameter, use it.
-  (when gnus-newsgroup-name
-    (let* ((group (or gnus-newsgroup-name ""))
-	   (tmp-pers (gnus-group-find-parameter group 'personality t)))
+  (when (and (not personality) gnus-newsgroup-name)
+    (let ((tmp-pers (gnus-group-find-parameter gnus-newsgroup-name 'personality t)))
       (when tmp-pers
 	(setq personality tmp-pers))))
 
emacs-goodies-el-35.8ubuntu2/debian/patches/50_ctypes.diff0000775000000000000000000002462112230377266020341 0ustar  #!/bin/sh -e
## 50_ctypes.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Add custom support to ctypes.el

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
--- a/elisp/emacs-goodies-el/ctypes.el
+++ b/elisp/emacs-goodies-el/ctypes.el
@@ -4,9 +4,9 @@
 
 ;; Author: Anders Lindgren 
 ;; Maintainer: Anders Lindgren 
-;; Version: 1.3.1
+;; Version: 1.4 by Peter S Galbraith
 ;; Created: 1997-03-16
-;; Date: 1999-06-23
+;; Date: 2003-11-10
 
 ;; CTypes is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -228,14 +228,26 @@
 
 ;;}}}
 
+;;; History:
+;;
+;; 1.3.1 is from http://www.juliocastillo.com/emacs/site-lisp/ctypes.el
+;;
+;; 1.4  Peter S Galbraith 
+;;  I can't find the author, so did a few changes myself.
+;;  - minor checkdoc changes (it still lists 43 documentation errors).
+;;  - custom support.
+;;  - add defcustom `ctypes-install' for easier setup in Debian package
+;;    emacs-goodies-el.
+
 ;;; Code:
 
 ;;{{{ Dependencies
 
-;; The only reason to load font-lock is to determinate the font-lock
+;; The only reason to load font-lock is to determine the font-lock
 ;; version we are using.
 
 (require 'font-lock)
+(require 'cc-mode)
 
 (eval-when-compile
   (require 'cl))
@@ -243,19 +255,38 @@
 ;;}}}
 ;;{{{ Variables
 
-(defvar ctypes-file-name "~/.ctypes"
-  "*Default name of file to read types from.
+(defgroup ctypes nil
+  "Enhanced Font lock support for custom defined types."
+  :group 'programming)
+
+(defcustom ctypes-install nil
+  "*Whether to load this file at macs startup.
+Setting this variable will load the file to install the 'find-file-hooks
+and 'kill-emacs-hook hooks.  The effect is the same as adding
+ (require 'ctypes)
+in your Emacs initilization file.
+The file ctypes.el must be in the Emacs load-path when the customization
+code is run in .emacs otherwise Emacs will not find it and will yield an
+error."
+  :type 'boolean
+  :require 'ctypes
+  :group 'ctypes)
 
+(defcustom ctypes-file-name "~/.ctypes"
+  "*Default name of file to read types from.
 When `ctypes-read-file' and `ctypes-write-file' are called interactively
-the directory part of the file name is ignored.")
-
+the directory part of the file name is ignored."
+  :type 'file
+  :group 'ctypes)
 
-(defvar ctypes-write-types-at-exit nil
+(defcustom ctypes-write-types-at-exit nil
   "*When non-nil types are saved to file when Emacs exits.
-
-When this variable be 'ask, the user is prompted before the
-types are saved.")
-
+When this variable be 'ask, the user is prompted before the types are saved."
+  :type '(choice
+          (const :tag "t; save to file when Emacs exits" t)
+          (const :tag "nil; do not save to file when Emacs exits" nil)
+          (const :tag "ask; prompt before saving" ask))
+  :group 'ctypes)
 
 (defvar ctypes-mode-descriptor
   (if (boundp 'c-font-lock-extra-types)
@@ -300,13 +331,13 @@
 when the function is called.")
 
 
-(defvar ctypes-dir-read-file nil
-  "*Variable determinating which files `ctypes-dir' should read.
+(defcustom ctypes-dir-read-file nil
+  "*Variable determining which files `ctypes-dir' should read.
 
-When search for types in a large number of files it is difficult
-to determine which files to parse.  Should to few be opened, we
-can miss some types.  The opposite, to open to many be opened,
-the parse process could take much longer than needed.
+When searching for types in a large number of files it is difficult to
+determine which files to parse.  Some types can be missed should too few
+file be opened, and the parse process could take much longer than needed
+with too many files.
 
 The default behavior, when `ctypes-dir-read-file' is nil, is to look
 at the extension of the files found.  Should it match a major mode in
@@ -331,11 +362,29 @@
     (setq ctypes-dir-read-file \"\\\\.cplusplus\\\\'\")
 
 However, the files would still need a -*- C++ -*- header line
-to be parsed as C++ files.")
-
+to be parsed as C++ files."
+  :type '(choice (const :tag "nil; fast approach." nil)
+                 (const :tag "t; read all non-backup files" t)
+                 (regexp :tag "regexp to match files"))
+  :group 'ctypes)
+
+(defcustom ctypes-dir-backup-files nil
+  "*Non-nil means that `ctypes-dir' should parse backup files."
+  :type 'boolean
+  :group 'ctypes)
+
+(defcustom ctypes-auto-parse-mode-hook nil
+  "*List of functions to run when `ctypes-auto-parse-mode' is activated."
+  :type 'hook
+  :group 'ctypes)
+
+(defcustom ctypes-load-hook nil
+  "*List of functions to run when `ctypes' is loaded."
+  :type 'hook
+  :group 'ctypes)
 
-(defvar ctypes-dir-backup-files nil
-  "*Non-nil means that `ctypes-dir' should parse backup files.")
+(defvar ctypes-saved-p t
+  "Nil when types not saved to file.")
 
 (defvar ctypes-auto-parse-mode nil
   "Non-nil when the minor mode `ctypes-auto-parse-mode' is enabled.
@@ -346,18 +395,6 @@
 To start the mode call the function `ctypes-auto-parse-mode', do not
 set this variable explicitly.")
 
-
-(defvar ctypes-auto-parse-mode-hook nil
-  "*List of functions to run when `ctypes-auto-parse-mode' is activated.")
-
-(defvar ctypes-load-hook nil
-  "*List of functions to run when `ctypes' is loaded.")
-
-
-(defvar ctypes-saved-p t
-  "Nil when types not saved to file.")
-
-
 (defvar ctypes-repetitive-type-regexp
   (concat "\\<\\(short\\|int\\|long\\|float\\|"
           "double\\|char\\|\\(un\\)?signed\\|const\\)\\>")
@@ -387,7 +424,7 @@
 When preceded by C-u the display is not updated.
 
 Return non-nil if the type was not known before."
-  (interactive 
+  (interactive
    (list
     (let* ((default (ctypes-get-type-under-point))
            (prompt (if default
@@ -400,7 +437,7 @@
       (error "Can't define \"\" as a type"))
   (or mode
       (setq mode major-mode))
-  (and type 
+  (and type
        (> (length type) 0)
        (let ((added (ctypes-add-types mode (list type))))
          (ctypes-perform-action mode added delay-action)
@@ -552,7 +589,7 @@
 When preceded by C-u the display is not updated.
 
 Return non-nil if type is removed."
-  (interactive 
+  (interactive
    (list
     (let* ((default (ctypes-get-type-under-point))
            (prompt (if default
@@ -828,7 +865,7 @@
 ;;{{{ Edit
 
 (defvar ctypes-edit-map nil
-  "Keymap used in ctypes-edit mode.")
+  "Keymap used in `ctypes-edit' mode.")
 (if ctypes-edit-map
     nil
   (setq ctypes-edit-map (make-sparse-keymap))
@@ -1087,7 +1124,7 @@
 
 
 (defun ctypes-subset (type-list1 type-list2)
-  "Non-nil if type-list1 is included in type-list2."
+  "Non-nil if TYPE-LIST1 is included in TYPE-LIST2."
   (let ((included t))
     (while (and included type-list1)
       (if (not (member (car type-list1) type-list2))
@@ -1127,7 +1164,7 @@
 
 The action is performed immediately for major modes in MODES, and for
 major modes that inherits types from modes in MODES, when
-`delay-action' is nil, and either changed-p is non-nil or the modes
+`delay-action' is nil, and either CHANGED-P is non-nil or the modes
 previously have been marked for delayed action.
 
 Should DELAY-ACTION be non-nil, the actions are not performed
@@ -1189,7 +1226,7 @@
 
 
 (defun ctypes-perform-delayed-action ()
-  "Perform the action (normally update the display)"
+  "Perform the action (normally update the display)."
   (ctypes-perform-action ctypes-delayed-action-list nil nil))
 
 ;;}}}
@@ -1243,7 +1280,7 @@
     (set (make-local-variable 'parse-sexp-ignore-comments) t)
     (unwind-protect
         (let ((lst '()))
-          (while (re-search-forward 
+          (while (re-search-forward
                   "^\\(\\(typedef\\)\\|class\\|struct\\|enum\\)\\>" nil t)
             (condition-case ()
                 (if (match-beginning 2)
@@ -1494,15 +1531,15 @@
                        (forward-char -1)
                      (goto-char end))
                    (skip-chars-backward " \t")
-                   (setq modes 
-                         (cons (intern 
-                                (concat 
-                                 (downcase 
+                   (setq modes
+                         (cons (intern
+                                (concat
+                                 (downcase
                                   (buffer-substring beg (point))) "-mode"))
                                modes)))
                ;; Simple -*-MODE-*- case.
-               (setq modes 
-                     (cons (intern 
+               (setq modes
+                     (cons (intern
                             (concat (downcase (buffer-substring beg end))
                                                  "-mode"))
                                  modes))))))
@@ -1559,7 +1596,7 @@
 
 
 (defun ctypes-string-to-mode (mode)
-  "Convert a mode name, entered by the user, to a mode symbol.
+  "Convert a MODE name, entered by the user, to a mode symbol.
 
 Example:
     (ctypes-string-to-mode \"C++\")  =>  c++-mode"
@@ -1659,7 +1696,7 @@
           ;; Fontify each declaration item.
           (list 'font-lock-match-c++-style-declaration-item-and-skip-to-next
             ;; Start with point after all type specifiers.
-            (list 'goto-char 
+            (list 'goto-char
                   (list 'or (list 'match-beginning
                                   (+ 2 (regexp-opt-depth regexp)))
                         '(match-end 1)))
@@ -1682,7 +1719,7 @@
               ((= number 2)
                (setq keywords keyword-2))
               (t
-               (error "Incorrect entry in rule.  Found `%s', expected 1 or 2."
+               (error "Incorrect entry in rule.  Found `%s', expected 1 or 2"
                       number)))
         (if append-p
             (set var (append (symbol-value var) (list keywords)))
@@ -1730,13 +1767,11 @@
 
 ;;}}}
 
-;; The End
-
+;; Install ourself
 (add-hook 'find-file-hooks 'ctypes-find-file-hook)
 (add-hook 'kill-emacs-hook 'ctypes-kill-emacs-hook)
 
-(provide 'ctypes)
-
 (run-hooks 'ctypes-load-hook)
+(provide 'ctypes)
 
-;; ctypes.el ends here.
+;;; ctypes.el ends here
emacs-goodies-el-35.8ubuntu2/debian/patches/50_slang-mode_bug336352.diff0000775000000000000000000000143112230377266022375 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 50_slang-mode_bug336352.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/emacs-goodies-el/slang-mode.el emacs-goodies-el/elisp/emacs-goodies-el/slang-mode.el
--- emacs-goodies-el~/elisp/emacs-goodies-el/slang-mode.el	2004-08-14 23:36:34.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/slang-mode.el	2005-10-30 19:53:52.000000000 -0500
@@ -93,7 +93,7 @@
   :prefix "slang-"
   :group 'languages)
 
-(defcustom slang-default-application "c:/bin/slsh.exe"
+(defcustom slang-default-application "/usr/bin/slsh"
   "Default slang application to run in slang subprocess."
   :type 'string
   :group 'slang)
emacs-goodies-el-35.8ubuntu2/debian/patches/50_silly-mail.diff0000775000000000000000000013430212230377266021104 0ustar  #!/bin/sh -e
## 50_silly-mail.dpatch.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Add custom support.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad emacs-goodies-el~/elisp/emacs-goodies-el/silly-mail.el emacs-goodies-el/elisp/emacs-goodies-el/silly-mail.el
--- emacs-goodies-el~/elisp/emacs-goodies-el/silly-mail.el	2003-04-04 15:16:10.000000000 -0500
+++ emacs-goodies-el/elisp/emacs-goodies-el/silly-mail.el	2007-08-08 19:36:46.000000000 -0400
@@ -28,42 +28,122 @@
 
 ;;; Commentary:
 
-;; To use this, put the following in your .emacs:
+;; To use this, invoke `M-x sm-add-random-header' from a mail composition
+;; buffer to insert a random header.  You may call the command again to
+;; substitute the inserted header by another.
+;;
+;; Use 'M-x sm-delete-last-header' to remove it.
+;;
+;; If you wish all mail messages to have a randomly chosen header, put the
+;; following in your .emacs:
 ;;
 ;;    (autoload 'sm-add-random-header "silly-mail" nil t)
 ;;    (add-hook 'mail-setup-hook 'sm-add-random-header)
+;;    (add-hook 'mh-letter-mode-hook 'sm-add-random-header)
+;;
+;;  or alternatively customize the variable `sm-add-ramdom-header-to-mail'.
+;;
+;; To setup menu-bar entries in sendmail and MH-E menus, customize the
+;; variable `sm-add-menu-bar-entries'.  This has the disadvantage of
+;; loading this library at Emacs startup, so might not be a good choice if
+;; you rarely use silly-mail.
+;;
+;; You may customize silly-mail using `M-x customize-group [RET] silly-mail'.
+;; The following are customizable:
+;;
+;;  - The list of header types used in the random selection by
+;;    `sm-add-random-header'
+;;  - Individual quotes may be disabled from the pool if some are offensive
+;;    to you.
+;;  - Whether all headers use an "X-" prefix or not.
 
 ;; I solicit more randomly generated headers commands.
 
 ;; Some of the options in this program require some external packages which
-;; are not a standard part of emacs, e.g. shop.el and flame.el (flame.el is
+;; are not a standard part of Emacs, e.g. shop.el and flame.el (flame.el is
 ;; present in XEmacs and Emacs 18, but missing from Emacs 19).  These are
 ;; available from http://www.splode.com/users/friedman/software/emacs-lisp/
 
+;;; History:
+;; 
+;;  2003-11-25 Peter S Galbraith 
+;;
+;;  - Added custom support.  I had to change quote variables from vectors
+;;    to lists to use the `set' custom type, but this had no impact on the
+;;    code.  I also had to change the format of the `sm-mail-header-table'
+;;    variable (leading to a minor change in `sm-use-header-function-p').
+;;    The variable `sm-mail-header-table' is not generated when the variable
+;;    `sm-mail-header-used' customization is set.
+;;  - Made `sm-add-random-header' replace the inserted header if called a
+;;    second time.
+;;  - Added `sm-delete-last-header'.
+;;  - Added optional "X-" prefix for those headers that didn't have them.
+;;  - Added custom variables `sm-add-ramdom-header-to-mail' and
+;;    `sm-add-menu-bar-entries'
+
 ;;; Code:
 
-(require 'sendmail)
+;; Try without requiring sendmail, as byte-compilations fails if
+;; /usr/bin/mail doesn't exist (Closes: #434104)
+;;
+;;(require 'sendmail)
+
+(defgroup silly-mail nil
+  "Generate bozotic mail headers."
+  :group 'mail
+  :group 'mh
+  :group 'sendmail)
+
+(defcustom sm-add-ramdom-header-to-mail nil
+  "Setup sendmail and MH-E to call `sm-add-random-header' automatically."
+  :type 'boolean
+  :require 'silly-mail
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (cond
+          (value
+           (add-hook 'mail-setup-hook 'sm-add-random-header)
+           (add-hook 'mh-letter-mode-hook 'sm-add-random-header))
+          (t
+           (remove-hook 'mail-setup-hook 'sm-add-random-header)
+           (remove-hook 'mh-letter-mode-hook 'sm-add-random-header))))
+  :group 'silly-mail)
+
+(defvar mail-mode-map)
+(defvar mh-letter-mode-map)
+(defcustom sm-add-menu-bar-entries nil
+  "Setup silly-mail menu-bar entries in MH-E and sendmail."
+  :type 'boolean
+  :require 'silly-mail
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (when value
+           (easy-menu-define sm-menu-map nil "silly-mail mh-letter menu"
+             '("Silly Mail"
+               ["Add Random Header" sm-add-random-header]
+               ["Delete Last Header" sm-delete-last-header]))
+
+           (eval-after-load "sendmail"
+             '(easy-menu-add-item mail-mode-map '("menu-bar" "headers")
+                                  sm-menu-map))           
+           (eval-after-load "mh-comp"
+             '(easy-menu-add-item mh-letter-mode-map '("menu-bar" "Letter")
+                                  sm-menu-map))))
+  :group 'silly-mail)
+
+(defcustom sm-always-X-prefix nil
+  "Whether to use \"X-\" prefix in all silly-mail headers.
+This affects headers Emacs, Microsoft and Tomato."
+  :type 'boolean
+  :group 'silly-mail)
 
 (random t)
 
-(defvar sm-mail-header-table
-  '(sm-add-antipastobozoticataclysm
-    (sm-add-at&t-hype           youwill             "youwill")
-    sm-add-drdoom-fodder
-    sm-add-emacs-name
-    sm-add-emacs-taunt
-    (sm-add-flame               *flame              "flame")
-    (sm-add-horoscope           horoscope           "horoscope")
-    (sm-add-kibology            kibologize          "kibologize")
-    sm-add-meat
-    sm-add-microsoft
-    sm-add-nsa-fodder
-    (sm-add-shopping-list       shop-string         "shop")
-    sm-add-tom-swifty
-    sm-add-tomato
-    (sm-add-uboat-death-message uboat-death-message "uboat")
-    sm-add-x-taunt
-    sm-add-zippy-quote)
+(defvar sm-header-last-inserted nil
+  "Last header field inserted by silly-mail, such that it can be undone.")
+(make-variable-buffer-local 'sm-header-last-inserted)
+
+(defvar sm-mail-header-table nil
   "List of routines which generate silly mail headers.
 Each element is either a symbol or a list.
 If an element is a function, that function can be called.
@@ -72,25 +152,103 @@
    2. A symbol naming a function required by the header-generator.
       If this function is not defined, the header-generator cannot run.
    3. The name of a library to load if the required function isn't defined.
-      If the load fails, or if `sm-load-missing-libraries' is `nil',
-      the corresponding header-generator function won't be used.")
+      If the load fails, or if `sm-load-missing-libraries' is nil,
+      the corresponding header-generator function won't be used.
 
-(defvar sm-load-missing-libraries t
-  "*If non-`nil', load missing libraries for header functions.
+This variable is set via `sm-mail-header-used' customization.")
+
+(defvar sm-mail-header-translation
+  '(("X-Antipastobozoticataclysm" sm-add-antipastobozoticataclysm)
+    ("X-AT&T-Hype" sm-add-at&t-hype youwill "youwill")
+    ("X-Drdoom-Fodder" sm-add-drdoom-fodder)
+    ("X-Emacs-Acronym" sm-add-emacs-name)
+    ("(X-)Emacs" sm-add-emacs-taunt)
+    ("X-Flame" sm-add-flame *flame "flame")
+    ("X-Horoscope" sm-add-horoscope horoscope "horoscope")
+    ("X-Kibo-Says" sm-add-kibology kibologize "kibologize")
+    ("X-Meat" sm-add-meat)
+    ("(X-)Microsoft" sm-add-microsoft)
+    ("X-NSA-Fodder" sm-add-nsa-fodder)
+    ("X-Shopping-List" sm-add-shopping-list shop-string "shop")
+    ("X-Tom-Swifty" sm-add-tom-swifty)
+    ("(X-)Tomato" sm-add-tomato)
+    ("X-Uboat-Death-Message"
+     sm-add-uboat-death-message uboat-death-message "uboat")
+    ("X-Windows" sm-add-x-taunt)
+    ("X-Zippy-Says" sm-add-zippy-quote)))
+
+(defcustom sm-mail-header-used
+  '("X-Antipastobozoticataclysm"
+    "X-AT&T-Hype"
+    "X-Drdoom-Fodder"
+    "X-Emacs-Acronym"
+    "(X-)Emacs"
+    "X-Flame"
+    "X-Horoscope"
+    "X-Kibo-Says"
+    "X-Meat"
+    "(X-)Microsoft"
+    "X-NSA-Fodder"
+    "X-Shopping-List"
+    "X-Tom-Swifty"
+    "(X-)Tomato"
+    "X-Uboat-Death-Message"
+    "X-Windows"
+    "X-Zippy-Says")
+  "Header fields used ramdomly in silly-mail."
+  :type `(set
+          (const "X-Antipastobozoticataclysm")
+          (const "X-AT&T-Hype")
+          (const "X-Drdoom-Fodder")
+          (const "X-Emacs-Acronym")
+          (const "(X-)Emacs")
+          (const "X-Flame")
+          (const "X-Horoscope")
+          (const "X-Kibo-Says")
+          (const "X-Meat")
+          (const "(X-)Microsoft")
+          (const "X-NSA-Fodder")
+          (const "X-Shopping-List")
+          (const "X-Tom-Swifty")
+          (const "(X-)Tomato")
+          (const "X-Uboat-Death-Message")
+          (const "X-Windows")
+          (const "X-Zippy-Says"))
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (setq sm-mail-header-table nil)
+         (when value
+           (let ((the-list value))
+             (while the-list
+               (let ((item (car the-list)))
+                 (setq sm-mail-header-table
+                       (append
+                        sm-mail-header-table
+                        (list (cdr (assoc item sm-mail-header-translation)))))
+                 (setq the-list (cdr the-list)))))))
+  :group 'silly-mail)
+
+(defcustom sm-load-missing-libraries nil
+  "*If non-nil, load missing libraries for header functions.
 If nil, then if a library is not already loaded, the dependent
-header-generating function will not be used.")
+header-generating function will not be used."
+  :type 'boolean
+  :group 'silly-mail)
 
 ;;;###autoload
 (defun sm-add-random-header ()
   "Insert a random silly mail header.
-The choice of available headers is taken from sm-mail-header-table."
+The choice of available headers is taken from `sm-mail-header-table'.
+If a random header was already inserted, it it removed in favor of a new one."
   (interactive)
+  (if sm-header-last-inserted
+    (sm-delete-last-header))
   (funcall (sm-random-header-function)))
 
 ;;;###autoload
 (defun sm-add-all-headers ()
   "Insert one of every kind of silly mail header defined.
-The choice of available headers is taken from sm-mail-header-table."
+The choice of available headers is taken from `sm-mail-header-table'."
   (interactive)
   (let ((fns sm-mail-header-table)
         fn)
@@ -110,7 +268,7 @@
 
 
 (defun sm-use-header-function-p (func)
-  (cond ((consp func)
+  (cond ((eq 3 (length func))
          (let ((fn (nth 0 func))
                (fbound-sym (nth 1 func))
                (lib (nth 2 func)))
@@ -120,7 +278,7 @@
                        (load lib t)
                        (fboundp fbound-sym))
                   fn))))
-        (t func)))
+        (t (car func))))
 
 
 (defvar sm-fill-single-line-width   78)
@@ -186,6 +344,10 @@
       (kill-buffer buf)))
   (sm-put-header header contents))
 
+(defsubst sm-put-header-contents (header items &optional separator)
+  (sm-put-header header
+    (mapconcat 'identity items (or separator " "))))
+
 (defsubst sm-put-random-sequence-items (header sequence &optional range)
   (sm-put-header-contents header
     (apply 'sm-random-sequence-items sequence range)))
@@ -195,17 +357,13 @@
     items
     (concat "\n" (make-string sm-fill-indent-width ?\040))))
 
-(defsubst sm-put-header-contents (header items &optional separator)
-  (sm-put-header header
-    (mapconcat 'identity items (or separator " "))))
-
 (defun sm-put-random-sequence-items-to-eol (header sequence &optional sep)
   (or sep (setq sep " "))
   (let ((width (- sm-fill-single-line-width (length header) 2))
         (seqlen (length sequence))
         (len 0)
         (continuep t)
-        items tem new-len)
+        items tem newlen)
     (while continuep
       (setq tem (sm-sequence-item sequence (random seqlen)))
       (setq newlen (+ len (length sep) (length tem)))
@@ -231,8 +389,29 @@
                        (goto-char (match-end 0)))))
             (delete-region beg end)))
       (insert contents)
+      (setq sm-header-last-inserted header)
       (set-buffer-modified-p buf-mod-p))))
 
+(defun sm-delete-header (header)
+  "Delete HEADER and its content is it exists."
+  (save-excursion
+    (let ((buf-mod-p (buffer-modified-p))
+          (header-exists (mail-position-on-field header)))
+      (if header-exists
+          (delete-region (point)
+                         (progn
+                           (re-search-backward (concat header ": "))
+                           (forward-char -1)
+                           (point)))))))
+
+(defun sm-delete-last-header ()
+  "Delete the last header field inserted by silly-mail."
+  (interactive)
+  (if (not sm-header-last-inserted)
+      (message "Nothing to delete yet")
+    (sm-delete-header sm-header-last-inserted)
+    (setq sm-header-last-inserted nil)))
+
 (put 'sm-put-header-fill-content 'lisp-indent-function 1)
 (put 'sm-put-header-contents 'lisp-indent-function 1)
 (put 'sm-put-header 'lisp-indent-function 1)
@@ -243,9 +422,14 @@
 (defvar sm-antipastobozoticataclysm-header
   "X-Antipastobozoticataclysm")
 
-(defvar sm-antipastobozoticataclysm-table
-  ["Bariumenemanilow"
-   "When George Bush projectile vomits antipasto on the Japanese."])
+(defcustom sm-antipastobozoticataclysm-table
+  '("Bariumenemanilow"
+    "When George Bush projectile vomits antipasto on the Japanese.")
+  "List of entries for `sm-add-antipastobozoticataclysm'."
+  :type '(set
+          (const "Bariumenemanilow")
+          (const "When George Bush projectile vomits antipasto on the Japanese."))
+  :group 'silly-mail)
 
 (defun sm-add-antipastobozoticataclysm ()
   (interactive)
@@ -267,8 +451,19 @@
 
 (defvar sm-drdoom-fodder-header "X-Drdoom-Fodder")
 
-(defvar sm-drdoom-fodder-words
-  ["CERT" "crash" "crypt" "drdoom" "passwd" "security" "root" "satan"])
+(defcustom sm-drdoom-fodder-words
+  '("CERT" "crash" "crypt" "drdoom" "passwd" "security" "root" "satan")
+  "List of entries for `sm-add-drdoom-fodder'."
+  :type '(set
+          (const "CERT")
+          (const "crash")
+          (const "crypt")
+          (const "drdoom")
+          (const "passwd")
+          (const "security")
+          (const "root")
+          (const "satan"))
+  :group 'silly-mail)
 
 (defvar sm-drdoom-fodder-length-range
   (list 5 (length sm-drdoom-fodder-words)))
@@ -285,62 +480,118 @@
 ;; These have been contributed by people all over the network
 ;; (see the file etc/JOKES or emacs.names in the Emacs 19 distribution).
 ;; I modified some of them.
-(defvar sm-emacs-name-table
-  ["Each Mail A Continued Surprise"
-   "Each Manual's Audience is Completely Stupified"
-   "Easily Maintained with the Assistance of Chemical Solutions"
-   "Easily Mangles, Aborts, Crashes and Stupifies"
-   "Eating Memory And Cycle-Sucking"
-   "Editing MACroS"
-   "Edwardian Manifestation of All Colonial Sins"
-   "Egregious Managers Actively Court Stallman"
-   "Eight Megabytes And Constantly Swapping"
-   "Eleven Monkeys Asynchronously Create Slogans"
-   "Elsewhere Maybe All Commands are Simple"
-   "Elsewhere Maybe Alternative Civilizations Survive"
-   "Elvis Masterminds All Computer Software"
-   "Emacs Macht Alle Computer Schoen"
-   "Emacs Made Almost Completely Screwed"
-   "Emacs Maintainers Are Crazy Sickos"
-   "Emacs Makes A Computer Slow"
-   "Emacs Makes All Computing Simple"
-   "Emacs Manuals Always Cause Senility"
-   "Emacs Manuals Are Cryptic and Surreal"
-   "Emacs Masquerades As Comfortable Shell"
-   "Emacs May Alienate Clients and Supporters"
-   "Emacs May Allow Customised Screwups"
-   "Emacs May Annihilate Command Structures"
-   "Emacs Means A Crappy Screen"
-   "Emacs: My Alternative Computer Story"
-   "Embarrassed Manual-Writer Accused of Communist Subversion"
-   "Embarrassingly Mundane Advertising Cuts Sales"
-   "Emetic Macros Assault Core and Segmentation"
-   "Energetic Merchants Always Cultivate Sales"
-   "Equine Mammals Are Considerably Smaller"
-   "Eradication of Memory Accomplished with Complete Simplicity"
-   "Erasing Minds Allows Complete Submission"
-   "Escape Meta Alt Control Shift"
-   "Esoteric Malleability Always Considered Silly"
-   "Even My Aunt Crashes the System"
-   "Even a Master of Arts Comes Simpler"
-   "Evenings, Mornings, And a Couple of Saturdays"
-   "Eventually Munches All Computer Storage"
-   "Ever Made A Control-key Setup?"
-   "Every Male Adolescent Craves Sex"
-   "Every Mode Accelerates Creation of Software"
-   "Every Mode Acknowledges Customized Strokes"
-   "Every Moron Assumes CCA is Superior"
-   "Everyday Material Almost Compiled Successfully"
-   "Excavating Mayan Architecture Comes Simpler"
-   "Excellent Manuals Are Clearly Suppressed"
-   "Exceptionally Mediocre Algorithm for Computer Scientists"
-   "Exceptionally Mediocre Autocratic Control System"
-   "Experience the Mildest Ad Campaign ever Seen"
-   "Extended Macros Are Considered Superfluous"
-   "Extensibility and Modifiability Aggravate Confirmed Simpletons"
-   "Extraneous Macros And Commands Stink"
-   "Generally Not Used (Except by Middle Aged Computer Scientists)"]
-  "EMACS acronym expansions.")
+(defcustom sm-emacs-name-table
+  '("Each Mail A Continued Surprise"
+    "Each Manual's Audience is Completely Stupified"
+    "Easily Maintained with the Assistance of Chemical Solutions"
+    "Easily Mangles, Aborts, Crashes and Stupifies"
+    "Eating Memory And Cycle-Sucking"
+    "Editing MACroS"
+    "Edwardian Manifestation of All Colonial Sins"
+    "Egregious Managers Actively Court Stallman"
+    "Eight Megabytes And Constantly Swapping"
+    "Eleven Monkeys Asynchronously Create Slogans"
+    "Elsewhere Maybe All Commands are Simple"
+    "Elsewhere Maybe Alternative Civilizations Survive"
+    "Elvis Masterminds All Computer Software"
+    "Emacs Macht Alle Computer Schoen"
+    "Emacs Made Almost Completely Screwed"
+    "Emacs Maintainers Are Crazy Sickos"
+    "Emacs Makes A Computer Slow"
+    "Emacs Makes All Computing Simple"
+    "Emacs Manuals Always Cause Senility"
+    "Emacs Manuals Are Cryptic and Surreal"
+    "Emacs Masquerades As Comfortable Shell"
+    "Emacs May Alienate Clients and Supporters"
+    "Emacs May Allow Customised Screwups"
+    "Emacs May Annihilate Command Structures"
+    "Emacs Means A Crappy Screen"
+    "Emacs: My Alternative Computer Story"
+    "Embarrassed Manual-Writer Accused of Communist Subversion"
+    "Embarrassingly Mundane Advertising Cuts Sales"
+    "Emetic Macros Assault Core and Segmentation"
+    "Energetic Merchants Always Cultivate Sales"
+    "Equine Mammals Are Considerably Smaller"
+    "Eradication of Memory Accomplished with Complete Simplicity"
+    "Erasing Minds Allows Complete Submission"
+    "Escape Meta Alt Control Shift"
+    "Esoteric Malleability Always Considered Silly"
+    "Even My Aunt Crashes the System"
+    "Even a Master of Arts Comes Simpler"
+    "Evenings, Mornings, And a Couple of Saturdays"
+    "Eventually Munches All Computer Storage"
+    "Ever Made A Control-key Setup?"
+    "Every Male Adolescent Craves Sex"
+    "Every Mode Accelerates Creation of Software"
+    "Every Mode Acknowledges Customized Strokes"
+    "Every Moron Assumes CCA is Superior"
+    "Everyday Material Almost Compiled Successfully"
+    "Excavating Mayan Architecture Comes Simpler"
+    "Excellent Manuals Are Clearly Suppressed"
+    "Exceptionally Mediocre Algorithm for Computer Scientists"
+    "Exceptionally Mediocre Autocratic Control System"
+    "Experience the Mildest Ad Campaign ever Seen"
+    "Extended Macros Are Considered Superfluous"
+    "Extensibility and Modifiability Aggravate Confirmed Simpletons"
+    "Extraneous Macros And Commands Stink"
+    "Generally Not Used (Except by Middle Aged Computer Scientists)")
+  "List of EMACS acronym expansions for `sm-add-emacs-name'."
+  :type '(set
+          (const "Each Mail A Continued Surprise")
+          (const "Each Manual's Audience is Completely Stupified")
+          (const "Easily Maintained with the Assistance of Chemical Solutions")
+          (const "Easily Mangles, Aborts, Crashes and Stupifies")
+          (const "Eating Memory And Cycle-Sucking")
+          (const "Editing MACroS")
+          (const "Edwardian Manifestation of All Colonial Sins")
+          (const "Egregious Managers Actively Court Stallman")
+          (const "Eight Megabytes And Constantly Swapping")
+          (const "Eleven Monkeys Asynchronously Create Slogans")
+          (const "Elsewhere Maybe All Commands are Simple")
+          (const "Elsewhere Maybe Alternative Civilizations Survive")
+          (const "Elvis Masterminds All Computer Software")
+          (const "Emacs Macht Alle Computer Schoen")
+          (const "Emacs Made Almost Completely Screwed")
+          (const "Emacs Maintainers Are Crazy Sickos")
+          (const "Emacs Makes A Computer Slow")
+          (const "Emacs Makes All Computing Simple")
+          (const "Emacs Manuals Always Cause Senility")
+          (const "Emacs Manuals Are Cryptic and Surreal")
+          (const "Emacs Masquerades As Comfortable Shell")
+          (const "Emacs May Alienate Clients and Supporters")
+          (const "Emacs May Allow Customised Screwups")
+          (const "Emacs May Annihilate Command Structures")
+          (const "Emacs Means A Crappy Screen")
+          (const "Emacs: My Alternative Computer Story")
+          (const "Embarrassed Manual-Writer Accused of Communist Subversion")
+          (const "Embarrassingly Mundane Advertising Cuts Sales")
+          (const "Emetic Macros Assault Core and Segmentation")
+          (const "Energetic Merchants Always Cultivate Sales")
+          (const "Equine Mammals Are Considerably Smaller")
+          (const "Eradication of Memory Accomplished with Complete Simplicity")
+          (const "Erasing Minds Allows Complete Submission")
+          (const "Escape Meta Alt Control Shift")
+          (const "Esoteric Malleability Always Considered Silly")
+          (const "Even My Aunt Crashes the System")
+          (const "Even a Master of Arts Comes Simpler")
+          (const "Evenings, Mornings, And a Couple of Saturdays")
+          (const "Eventually Munches All Computer Storage")
+          (const "Ever Made A Control-key Setup?")
+          (const "Every Male Adolescent Craves Sex")
+          (const "Every Mode Accelerates Creation of Software")
+          (const "Every Mode Acknowledges Customized Strokes")
+          (const "Every Moron Assumes CCA is Superior")
+          (const "Everyday Material Almost Compiled Successfully")
+          (const "Excavating Mayan Architecture Comes Simpler")
+          (const "Excellent Manuals Are Clearly Suppressed")
+          (const "Exceptionally Mediocre Algorithm for Computer Scientists")
+          (const "Exceptionally Mediocre Autocratic Control System")
+          (const "Experience the Mildest Ad Campaign ever Seen")
+          (const "Extended Macros Are Considered Superfluous")
+          (const "Extensibility and Modifiability Aggravate Confirmed Simpletons")
+          (const "Extraneous Macros And Commands Stink")
+          (const "Generally Not Used (Except by Middle Aged Computer Scientists)"))
+  :group 'silly-mail)
 
 (defun sm-add-emacs-name ()
   (interactive)
@@ -353,57 +604,97 @@
 
 (defvar sm-emacs-taunt-header "Emacs")
 
-(defvar sm-emacs-taunt-table
-  '["(setq software-quality (/ 1 number-of-authors))"
-    "a Lisp interpreter masquerading as ... a Lisp interpreter!"
-    "a compelling argument for pencil and paper."
-    "a learning curve that you can use as a plumb line."
-    "a real time environment for simulating molasses-based life forms."
-    "an inspiring example of form following function... to Hell."
-    "anything free is worth what you paid for it."
-    "ballast for RAM."
-    "because Hell was full."
-    "because editing your files should be a traumatic experience."
-    "because extension languages should come with the editor built in."
-    "because idle RAM is the Devil's playground."
-    "because one operating system isn't enough."
-    "because you deserve a brk today."
-    "don't cry -- it won't help."
-    "don't try this at home, kids!"
-    "ed  ::  20-megaton hydrogen bomb : firecracker"
-    "featuring the world's first municipal garbage collector!"
-    "freely redistributable; void where prohibited by law."
-    "if SIGINT doesn't work, try a tranquilizer."
-    "if it payed rent for disk space, you'd be rich."
-    "impress your (remaining) friends and neighbors."
-    "it's all fun and games, until somebody tries to edit a file."
-    "it's like swatting a fly with a supernova."
-    "it's not slow --- it's stately."
-    "Lovecraft was an optimist."
-    "more boundary conditions than the Middle East."
-    "more than just a Lisp interpreter, a text editor as well!"
-    "no job too big... no job."
-    "or perhaps you'd prefer Russian Roulette, after all?"
-    "Our Lady of Perpetual Garbage Collection"
-    "resistance is futile; you will be assimilated and byte-compiled."
-    "the Swiss Army of Editors."
-    "the answer to the world surplus of CPU cycles."
-    "the definitive fritterware."
-    "the only text editor known to get indigestion."
-    "the prosecution rests its case."
-    "the road to Hell is paved with extensibility."
-    "there's a reason it comes with a built-in psychotherapist."
-    "well, why *shouldn't* you pay property taxes on your editor?"
-    "where editing text is like playing Paganini on a glass harmonica."
-    "you'll understand when you're older, dear."]
-  "Facts about Emacs that you and your loved ones should be aware of.")
+(defcustom sm-emacs-taunt-table
+  '("a mistake carried out to perfection."
+    "a moment of convenience, a lifetime of regret."
+    "a terminal disease."
+    "all the problems and twice the bugs."
+    "complex nonsolutions to simple nonproblems."
+    "dissatisfaction guaranteed."
+    "don't get frustrated without it."
+    "even not doing anything would have been better than nothing."
+    "even your dog won't like it."
+    "flaky and built to stay that way."
+    "flawed beyond belief."
+    "foiled again."
+    "form follows malfunction."
+    "garbage at your fingertips."
+    "graphics hacking :: Roman numerals : sqrt (pi)"
+    "ignorance is our most important resource."
+    "it could be worse, but it'll take time."
+    "it could happen to you."
+    "it was hard to write; it should be hard to use."
+    "let it get in *your* way."
+    "live the nightmare."
+    "more than enough rope."
+    "never had it, never will."
+    "no hardware is safe."
+    "power tools for power fools."
+    "power tools for power losers."
+    "putting new limits on productivity."
+    "simplicity made complex."
+    "some voids are better left unfilled."
+    "sometimes you fill a vacuum and it still sucks."
+    "the art of incompetence."
+    "the cutting edge of obsolescence."
+    "the defacto substandard."
+    "the first fully modular software disaster."
+    "the joke that kills."
+    "the problem for your problem."
+    "there's got to be a better way."
+    "warn your friends about it."
+    "you'd better sit down."
+    "you'll envy the dead.")
+  "List of entries for `sm-add-emacs-taunt' (What users said as they collapsed)."
+  :type '(set
+          (const "a mistake carried out to perfection.")
+          (const "a moment of convenience, a lifetime of regret.")
+          (const "a terminal disease.")
+          (const "all the problems and twice the bugs.")
+          (const "complex nonsolutions to simple nonproblems.")
+          (const "dissatisfaction guaranteed.")
+          (const "don't get frustrated without it.")
+          (const "even not doing anything would have been better than nothing.")
+          (const "even your dog won't like it.")
+          (const "flaky and built to stay that way.")
+          (const "flawed beyond belief.")
+          (const "foiled again.")
+          (const "form follows malfunction.")
+          (const "garbage at your fingertips.")
+          (const "graphics hacking :: Roman numerals : sqrt (pi)")
+          (const "ignorance is our most important resource.")
+          (const "it could be worse, but it'll take time.")
+          (const "it could happen to you.")
+          (const "it was hard to write; it should be hard to use.")
+          (const "let it get in *your* way.")
+          (const "live the nightmare.")
+          (const "more than enough rope.")
+          (const "never had it, never will.")
+          (const "no hardware is safe.")
+          (const "power tools for power fools.")
+          (const "power tools for power losers.")
+          (const "putting new limits on productivity.")
+          (const "simplicity made complex.")
+          (const "some voids are better left unfilled.")
+          (const "sometimes you fill a vacuum and it still sucks.")
+          (const "the art of incompetence.")
+          (const "the cutting edge of obsolescence.")
+          (const "the defacto substandard.")
+          (const "the first fully modular software disaster.")
+          (const "the joke that kills.")
+          (const "the problem for your problem.")
+          (const "there's got to be a better way.")
+          (const "warn your friends about it.")
+          (const "you'd better sit down.")
+          (const "you'll envy the dead."))
+  :group 'silly-mail)
 
 (defun sm-add-emacs-taunt ()
   (interactive)
-  (sm-put-header sm-emacs-taunt-header
+  (sm-put-header (concat (if sm-always-X-prefix "X-") sm-emacs-taunt-header)
     (sm-random-sequence-item sm-emacs-taunt-table)))
 
-(setq bizarre-gratuitous-variable '(miscellaneous gratuitous list))
+;;(setq bizarre-gratuitous-variable '(miscellaneous gratuitous list))
 
 
 ;; Add an insulting flame into your mail headers.
@@ -446,40 +737,76 @@
 
 (defvar sm-meat-header "X-Meat")
 
-(defvar sm-meat-table
-  ["Abalone"
-   "Back Bacon"
-   "Bacon"
-   "Beef Jerky"
-   "Biltong"  ; african-style jerky, usually beef, ostrich, or antelope
-   "Blood sausage"
-   "Buffalo"
-   "Calimari"
-   "Chicken Fried Steak"
-   "Chicken"
-   "Clam Jerky"
-   "Duck"
-   "Flanken"
-   "Haggis"
-   "Ham"
-   "Head cheese"
-   "Liverwurst"
-   "Lobster"
-   "Long pork"
-   "Molinari"
-   "Olive Loaf"
-   "Parma"
-   "Prosciutto"
-   "Ptarmigan"
-   "Roo burgers"
-   "Salame"
-   "Spruce grouse"
-   "Squirrel"
-   "Swordfish"
-   "Turkey Jerky"
-   "Veal"
-   "Venison"
-   "Wallaby steak"])
+(defcustom sm-meat-table
+  '("Abalone"
+    "Back Bacon"
+    "Bacon"
+    "Beef Jerky"
+    "Biltong"   ; african-style jerky, usually beef, ostrich, or antelope
+    "Blood sausage"
+    "Buffalo"
+    "Calimari"
+    "Chicken Fried Steak"
+    "Chicken"
+    "Clam Jerky"
+    "Duck"
+    "Flanken"
+    "Haggis"
+    "Ham"
+    "Head cheese"
+    "Liverwurst"
+    "Lobster"
+    "Long pork"
+    "Molinari"
+    "Olive Loaf"
+    "Parma"
+    "Prosciutto"
+    "Ptarmigan"
+    "Roo burgers"
+    "Salame"
+    "Spruce grouse"
+    "Squirrel"
+    "Swordfish"
+    "Turkey Jerky"
+    "Veal"
+    "Venison"
+    "Wallaby steak")
+  "List of entries for `sm-add-meat'."
+  :type '(set
+          (const "Abalone")
+          (const "Back Bacon")
+          (const "Bacon")
+          (const "Beef Jerky")
+          (const "Biltong")
+          (const "Blood sausage")
+          (const "Buffalo")
+          (const "Calimari")
+          (const "Chicken Fried Steak")
+          (const "Chicken")
+          (const "Clam Jerky")
+          (const "Duck")
+          (const "Flanken")
+          (const "Haggis")
+          (const "Ham")
+          (const "Head cheese")
+          (const "Liverwurst")
+          (const "Lobster")
+          (const "Long pork")
+          (const "Molinari")
+          (const "Olive Loaf")
+          (const "Parma")
+          (const "Prosciutto")
+          (const "Ptarmigan")
+          (const "Roo burgers")
+          (const "Salame")
+          (const "Spruce grouse")
+          (const "Squirrel")
+          (const "Swordfish")
+          (const "Turkey Jerky")
+          (const "Veal")
+          (const "Venison")
+          (const "Wallaby steak"))
+  :group 'silly-mail)
 
 (defun sm-add-meat ()
   (interactive)
@@ -491,20 +818,32 @@
 
 (defvar sm-microsoft-header "Microsoft")
 
-(defvar sm-microsoft-table
-  ["I'm not laughing anymore."
-   "Making the world a better place... for Microsoft."
-   "Programs so large they have weather."
-   "We've got the solution for the problem we sold you."
-   "Where `market lock-in' means throwing away the keys."
-   "Where even the version numbers aren't Y2K-compliant"
-   "Where the service packs are larger than the original releases."
-   "With our software, there's no limit to what you can't do!"
-   "World domination wasn't enough -- we had to write bad software, too!"])
+(defcustom sm-microsoft-table
+  '("I'm not laughing anymore."
+    "Making the world a better place... for Microsoft."
+    "Programs so large they have weather."
+    "We've got the solution for the problem we sold you."
+    "Where `market lock-in' means throwing away the keys."
+    "Where even the version numbers aren't Y2K-compliant"
+    "Where the service packs are larger than the original releases."
+    "With our software, there's no limit to what you can't do!"
+    "World domination wasn't enough -- we had to write bad software, too!")
+  "List of entries for `sm-add-microsoft'."
+  :type '(set
+          (const "I'm not laughing anymore.")
+          (const "Making the world a better place... for Microsoft.")
+          (const "Programs so large they have weather.")
+          (const "We've got the solution for the problem we sold you.")
+          (const "Where `market lock-in' means throwing away the keys.")
+          (const "Where even the version numbers aren't Y2K-compliant")
+          (const "Where the service packs are larger than the original releases.")
+          (const "With our software, there's no limit to what you can't do!")
+          (const "World domination wasn't enough -- we had to write bad software, too!"))
+  :group 'silly-mail)
 
 (defun sm-add-microsoft ()
   (interactive)
-  (sm-put-header sm-microsoft-header
+  (sm-put-header (concat (if sm-always-X-prefix "X-") sm-microsoft-header)
     (sm-random-sequence-item sm-microsoft-table)))
 
 
@@ -547,8 +886,8 @@
 
 (defvar sm-tom-swifty-header "X-Tom-Swifty")
 
-(defvar sm-tom-swifty-table
-  '["\"All the cherry trees are dead,\" Tom said fruitlessly."
+(defcustom sm-tom-swifty-table
+  '("\"All the cherry trees are dead,\" Tom said fruitlessly."
     "\"And what should you set your PS1 shell variable to?\" Tom prompted."
     "\"Any fresh fruit in the kitchen?\" Tom asked peeringly."
     "\"C++ is the wave of the future,\" Tom said objectively."
@@ -645,7 +984,108 @@
     "\"Who drank the last beer?\" Tom asked, hopping mad."
     "\"You have new mail,\" Tom said in his usual delivery."
     "\"You light up my life,\" Tom said brightly."
-    "\"You pinhead,\" Tom said pointedly."])
+    "\"You pinhead,\" Tom said pointedly.")
+  "List of entries for `sm-add-tom-swifty'."
+  :type '(set
+          (const "\"All the cherry trees are dead,\" Tom said fruitlessly.")
+          (const "\"And what should you set your PS1 shell variable to?\" Tom prompted.")
+          (const "\"Any fresh fruit in the kitchen?\" Tom asked peeringly.")
+          (const "\"C++ is the wave of the future,\" Tom said objectively.")
+          (const "\"Care for some `suan la chow show'?\" Tom asked wantonly.")
+          (const "\"Condensed chicken soup,\" was Tom's canned response.")
+          (const "\"Darling, what vegetable becomes an act of passion when misspelled?\", Tom breathed ravishingly.")
+          (const "\"Eat me,\" was Tom's biting response.")
+          (const "\"Ed is the Standard Text Editor,\" Tom sed.")
+          (const "\"Evergreens have always been my favorite,\" Tom opined.")
+          (const "\"He came at me out of the blue,\" Tom said airily.")
+          (const "\"I am writing lots of little verses,\"  Tom said blankly.")
+          (const "\"I can't drink alcohol,\" Tom said spiritually.")
+          (const "\"I can't get this fire started,\" Tom said woodenly.")
+          (const "\"I can't stand baby food,\" Tom said in a strained voice.")
+          (const "\"I can't wait to see the doctor,\" Tom said impatiently.")
+          (const "\"I don't WANNA get drunk,\" Tom wined.")
+          (const "\"I don't have any piano music,\"  Tom said listlessly.")
+          (const "\"I don't have the slightest idea how to milk this cow,\" Tom said in utter confusion.")
+          (const "\"I don't understand how square roots work,\" Tom said irrationally.")
+          (const "\"I don't want any champagne!\" Tom said, blowing his top.")
+          (const "\"I feel like I'm running around in circles,\"  Tom said squarely.")
+          (const "\"I got to get a text-processor that does my files the right way,\" Tom said awkwardly.")
+          (const "\"I guess I shouldn't have broken the mirror,\" Tom reflected.")
+          (const "\"I hate Frere Jacques,\" Tom said as he roundly denounced it.")
+          (const "\"I have no intention of traversing binary trees!\", Tom barked.")
+          (const "\"I have to finish sorting these writing utensils,\" Tom said pensively.")
+          (const "\"I hope this emulsion works,\" Tom said in suspense.")
+          (const "\"I just burned my hand in the blast furnace,\" Tom said, overwrought.")
+          (const "\"I just don't understand the number seventeen,\" Tom said randomly.")
+          (const "\"I just got some chicken wire,\" Tom said defensively.")
+          (const "\"I just poisoned myself,\" Tom lyed.")
+          (const "\"I just sharpened my pencil,\" Tom said pointedly.")
+          (const "\"I like Gregorian chants,\" Tom intoned.")
+          (const "\"I like amputations,\" Tom said disarmingly.")
+          (const "\"I like sun cartridge tapes,\" Tom said quickly.")
+          (const "\"I never get good bridge hands,\" Tom said in passing.")
+          (const "\"I only like black and white,\" Tom said monotonously.")
+          (const "\"I really like penguins,\" Tom said in a flighty voice.")
+          (const "\"I recommend listening to radio station ``WHAT'',\" Tom said quietly.")
+          (const "\"I think it's time we got married,\" Tom said engagingly.")
+          (const "\"I train dolphins,\" Tom said purposefully.")
+          (const "\"I'll have to grade your test again,\" Tom remarked.")
+          (const "\"I'm completely bankrupt,\" Tom said senselessly.")
+          (const "\"I'm fond of Pavarotti,\" Tom said menacingly.")
+          (const "\"I'm gainfully employed at the Weight-Watchers gymnasium,\" Tom said wastefully.")
+          (const "\"I'm getting fat,\" Tom said expansively.")
+          (const "\"I'm going to copy this tape,\" Tom said for the record.")
+          (const "\"I'm hardly ever aware of what I'm going to do next,\" Tom said unconsciously.")
+          (const "\"I'm having deja-vu,\" Tom said again.")
+          (const "\"I'm really bored,\" Tom said flatly.")
+          (const "\"I'm sorry I broke your window,\" Tom said painfully.")
+          (const "\"I'm sorry to hear I knocked you up,\" Tom said after a pregnant pause.")
+          (const "\"I've burned my tongue,\" Tom said distastefully.")
+          (const "\"I've finished counting the horses,\" Tom said summarily.")
+          (const "\"I've got a bucket full of forearms,\" Tom said wistfully.")
+          (const "\"I've just been drafted,\"  Tom said impressively.")
+          (const "\"I've made a complete ash of myself,\" Tom said brazenly.")
+          (const "\"IBM is up 3 points,\" Tom said, taking stock of the situation.")
+          (const "\"If only we could piece together this crime,\" Tom said in a puzzled voice.")
+          (const "\"It needs more seasoning,\" Tom said sagely.")
+          (const "\"It's patently obvious,\" Tom said licentiously.")
+          (const "\"It's really cold out here,\" Tom said in a muffled voice.")
+          (const "\"It's really windy outside,\" said Tom with gusto.")
+          (const "\"Lisp is such a symbol-minded language,\" Tom commonly said.")
+          (const "\"My feet hurt,\" Tom said pedantically.")
+          (const "\"My lenses will stay perfectly clear,\" Tom said optimistically.")
+          (const "\"My mouse buttons don't work,\" Tom said in a depressed voice.")
+          (const "\"My terminal is completely screwed up,\" Tom cursed.")
+          (const "\"On the other hand, eating at a table is more civilized,\" Tom countered.")
+          (const "\"Quick!  Change the baby's diaper,\" Tom said rashly.")
+          (const "\"Socialism is dead,\" Tom communicated.")
+          (const "\"The ASCII standard sucks,\" Tom said characteristically.")
+          (const "\"The GNU project will probably not be Posix conformant,\" Tom said noncommittally.")
+          (const "\"The judge sentenced him to the chair,\" Tom said dielectrically.")
+          (const "\"The printer is using too much toner,\"  Tom said darkly.")
+          (const "\"The rooster was decapitated,\" Tom said in a crestfallen voice.")
+          (const "\"The sequence `M-4' is equivalent to `C-u 4',\" Tom said metaphorically.")
+          (const "\"The sky is falling,\" Tom said in a crushed voiced.")
+          (const "\"The sun just rose over the cemetary,\" Tom said in mourning.")
+          (const "\"This anesthetic isn't very effective,\" Tom said unnervingly.")
+          (const "\"This awl is broken,\" Tom said pointlessly.")
+          (const "\"This is illegal, I just know it,\" Tom said with conviction.")
+          (const "\"Turn that fan off,\" Tom said coldly.")
+          (const "\"VI is much better than EMACS,\" Tom said with joy.")
+          (const "\"Wait! You need to enable interrupts first!\" Tom said preemptorally.")
+          (const "\"We'll have to take the stairs,\" Tom said in an elevated voice.")
+          (const "\"We're all out of flowers,\" Tom said lackadaisically.")
+          (const "\"We're going to sue you for that window system,\" Tom said inexorably.")
+          (const "\"We're going to use decimal notation,\" Tom said tentatively.")
+          (const "\"Well, I guess we should pitch camp,\" Tom said tentatively.")
+          (const "\"Well, it didn't increase at all,\" Tom said, nonplussed.")
+          (const "\"What is today's date?\" Tom asked in a timely fashion.")
+          (const "\"When will the Hurd be released?\" Tom asked Machingly.")
+          (const "\"Who drank the last beer?\" Tom asked, hopping mad.")
+          (const "\"You have new mail,\" Tom said in his usual delivery.")
+          (const "\"You light up my life,\" Tom said brightly.")
+          (const "\"You pinhead,\" Tom said pointedly."))
+  :group 'silly-mail)
 
 (defun sm-add-tom-swifty ()
   (interactive)
@@ -661,17 +1101,26 @@
 
 (defvar sm-tomato-header "Tomato")
 
-(defvar sm-tomato-table
-  ["Beige"
-   "Green"
-   "Heliotrope"
-   "Mauve"
-   "Plaid"
-   "Polka-dot"])
+(defcustom sm-tomato-table
+  '("Beige"
+    "Green"
+    "Heliotrope"
+    "Mauve"
+    "Plaid"
+    "Polka-dot")
+  "List of entries for `sm-add-tomato'."
+  :type '(set
+          (const "Beige")
+          (const "Green")
+          (const "Heliotrope")
+          (const "Mauve")
+          (const "Plaid")
+          (const "Polka-dot"))
+  :group 'silly-mail)
 
 (defun sm-add-tomato ()
   (interactive)
-  (sm-put-header sm-tomato-header
+  (sm-put-header (concat (if sm-always-X-prefix "X-") sm-tomato-header)
     (sm-random-sequence-item sm-tomato-table)))
 
 
@@ -689,8 +1138,8 @@
 
 (defvar sm-x-taunt-header "X-Windows")
 
-(defvar sm-x-taunt-table
-  '["a mistake carried out to perfection."
+(defcustom sm-x-taunt-table
+  '("a mistake carried out to perfection."
     "a moment of convenience, a lifetime of regret."
     "a terminal disease."
     "all the problems and twice the bugs."
@@ -729,8 +1178,51 @@
     "there's got to be a better way."
     "warn your friends about it."
     "you'd better sit down."
-    "you'll envy the dead."]
-  "What users said as they collapsed.")
+    "you'll envy the dead.")
+  "List of entries for `sm-add-x-taunt' (What users said as they collapsed)."
+  :type '(set
+          (const "a mistake carried out to perfection.")
+          (const "a moment of convenience, a lifetime of regret.")
+          (const "a terminal disease.")
+          (const "all the problems and twice the bugs.")
+          (const "complex nonsolutions to simple nonproblems.")
+          (const "dissatisfaction guaranteed.")
+          (const "don't get frustrated without it.")
+          (const "even not doing anything would have been better than nothing.")
+          (const "even your dog won't like it.")
+          (const "flaky and built to stay that way.")
+          (const "flawed beyond belief.")
+          (const "foiled again.")
+          (const "form follows malfunction.")
+          (const "garbage at your fingertips.")
+          (const "graphics hacking :: Roman numerals : sqrt (pi)")
+          (const "ignorance is our most important resource.")
+          (const "it could be worse, but it'll take time.")
+          (const "it could happen to you.")
+          (const "it was hard to write; it should be hard to use.")
+          (const "let it get in *your* way.")
+          (const "live the nightmare.")
+          (const "more than enough rope.")
+          (const "never had it, never will.")
+          (const "no hardware is safe.")
+          (const "power tools for power fools.")
+          (const "power tools for power losers.")
+          (const "putting new limits on productivity.")
+          (const "simplicity made complex.")
+          (const "some voids are better left unfilled.")
+          (const "sometimes you fill a vacuum and it still sucks.")
+          (const "the art of incompetence.")
+          (const "the cutting edge of obsolescence.")
+          (const "the defacto substandard.")
+          (const "the first fully modular software disaster.")
+          (const "the joke that kills.")
+          (const "the problem for your problem.")
+          (const "there's got to be a better way.")
+          (const "warn your friends about it.")
+          (const "you'd better sit down.")
+          (const "you'll envy the dead."))
+  :group 'silly-mail)
+
 
 (defun sm-add-x-taunt ()
   (interactive)
@@ -747,6 +1239,7 @@
   (or (fboundp 'yow) (load "yow"))
   (sm-put-header-fill-content sm-zippy-quote-header (yow)))
 
+
 (provide 'silly-mail)
 
-;;; silly-mail.el ends here.
+;;; silly-mail.el ends here
emacs-goodies-el-35.8ubuntu2/debian/patches/50_bar-cursor_bug331430.diff0000775000000000000000000000117312230377266022421 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 50_bar-cursor_bug331430.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
--- a/elisp/emacs-goodies-el/bar-cursor.el
+++ b/elisp/emacs-goodies-el/bar-cursor.el
@@ -184,7 +184,7 @@
 if not passed in."
   (if (and bar-cursor-mode (not overwrite-mode))
 	  (bar-cursor-set-cursor-type 'bar frame)
-	(bar-cursor-set-cursor-type 'block frame)))
+	(bar-cursor-set-cursor-type 'box frame)))
 
 ;;; --------------------------------------------------------------------------
 (defgroup bar-cursor nil
emacs-goodies-el-35.8ubuntu2/debian/patches/40_missing_provide.diff0000775000000000000000000000155612230377266022234 0ustar  #!/bin/sh -e
## 9_missing_provide.dpatch.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
--- a/elisp/emacs-goodies-el/align-string.el
+++ b/elisp/emacs-goodies-el/align-string.el
@@ -98,3 +98,5 @@
 	  (setq i (1+ i)))))
     ;; Clear end marker.
     (set-marker end nil)))
+
+(provide 'align-string)
emacs-goodies-el-35.8ubuntu2/debian/patches/50_marker-visit_autoloads.diff0000775000000000000000000000321712230377266023520 0ustar  #!/bin/sh -e
## 50_marker-visit_autoloads.dpatch by Peter S Galbraith 
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Add autoloads.

if [ $# -ne 1 ]; then
    echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
    exit 1
fi

[ -f debian/patches/00patch-opts ] && . debian/patches/00patch-opts
patch_opts="${patch_opts:--f --no-backup-if-mismatch}"

case "$1" in
       -patch) patch $patch_opts -p1 < $0;;
       -unpatch) patch $patch_opts -p1 -R < $0;;
        *)
                echo >&2 "`basename $0`: script expects -patch|-unpatch as argument"
                exit 1;;
esac

exit 0

@DPATCH@
diff -urNad /home/psg/emacs/emacs-goodies-el/newfiles/emacs-goodies-el/elisp/emacs-goodies-el/marker-visit.el emacs-goodies-el/elisp/emacs-goodies-el/marker-visit.el
--- /home/psg/emacs/emacs-goodies-el/newfiles/emacs-goodies-el/elisp/emacs-goodies-el/marker-visit.el	2001-05-22 02:13:48.000000000 -0400
+++ emacs-goodies-el/elisp/emacs-goodies-el/marker-visit.el	2003-11-16 21:30:42.000000000 -0500
@@ -87,6 +87,7 @@
   (message error-message)
   (beep))
 
+;;;###autoload
 (defun marker-visit-prev ()
   "From point, visit the nearest mark earlier in the buffer."
   (interactive)
@@ -102,6 +103,7 @@
 	  (goto-char dest-mark)
 	(marker-visit-warn "No previous mark to visit")))))
 
+;;;###autoload
 (defun marker-visit-next ()
   "From point, visit the nearest mark later in the buffer."
   (interactive)
@@ -121,6 +123,7 @@
 	  (goto-char dest-mark)
 	(marker-visit-warn "No next mark to visit")))))
 
+;;;###autoload
 (defun marker-visit-truncate-mark-ring ()
   "Truncate the `mark-ring'."
   (interactive)
emacs-goodies-el-35.8ubuntu2/debian/patches/50_vm-bogofilter.diff0000664000000000000000000002135412230377266021603 0ustar  #! /bin/sh /usr/share/dpatch/dpatch-run
## 50_vm-bogofilter.dpatch by  
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: No description.

@DPATCH@
--- a/elisp/vm-bonus-el/vm-bogofilter.el
+++ b/elisp/vm-bonus-el/vm-bogofilter.el
@@ -1,6 +1,4 @@
-;;; vm-bogofilter.el version 1.1.4
-;;
-;; An interface between the VM mail reader and the bogofilter spam filter.
+;;; vm-bogofilter.el --- Interfaces VM with the bogofilter spam filter.
 ;;
 ;; Copyright (C) 2003-2006 by Bjorn Knutsson
 ;;
@@ -26,7 +24,13 @@
 ;; along with this program; if not, write to the Free Software
 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 ;;
-;;; Version history:
+;;; History:
+;; 
+;; v 1.1.5: Peter S. Galbraith 
+;;        * checkdoc clean.
+;;        * autoload tag for `vm-bogofilter-setup'
+;;        * Don't invoke `vm-bogofilter-setup' upon loading as that is against
+;;          coding convention.
 ;; v 1.1.4: Change in the way bogofilter is called
 ;;        * No longer uses formail to process mails
 ;;        * Slightly improved error handling
@@ -39,7 +43,7 @@
 ;;          Automatically called on loading, but can be called again
 ;;          to re-initialize the vm-bogofilter setup
 ;; v 1.1.2: Borg assimilation version (12-Sep-2003)
-;;        * Great minds think alike. Olivier Cappe independently 
+;;        * Great minds think alike. Olivier Cappe independently
 ;;          created his own version of vm-bogofilter.el based on
 ;;          vm-spamassassin.el with the same basic functions.
 ;;          He submitted a patch to my version to harmonize them.
@@ -69,14 +73,15 @@
 ;; v 1.0: initial release
 ;;        * First release, based on Markus Mohnen's vm-spamassassin
 ;;
-;;
+;;; Commentary:
+;; 
 ;; To use this program, you need reasonably recent versions of VM from
 ;; http://www.wonderworks.com/vm) and bogofilter from
 ;; http://sourceforge.net/projects/bogofilter/
 ;;
 ;; This version of the interface has been developed for, and tested
 ;; with, VM version 7.17 and later, and bogofilter version 0.17.4 and
-;; later. Some features used /require/ bogofilter version 0.15.0 and
+;; later.  Some features used /require/ bogofilter version 0.15.0 and
 ;; later but no testing of versions earlier than 0.17.4 has been done.
 ;; It has been tested with bogofilter versions up to 0.93.2
 ;;
@@ -88,6 +93,7 @@
 ;;  ~/.vm startup file
 ;;
 ;;      (require 'vm-bogofilter)
+;;      (vm-bogofilter-setup)
 ;;
 ;;
 ;;; Usage:
@@ -179,7 +185,9 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'vm))
+(eval-when-compile
+  (load-library "cl-macs")
+  (require 'vm))
 
 ;;; Customisation:
 
@@ -193,43 +201,44 @@
   :type 'string)
 
 (defcustom vm-bogofilter-program-options "-u -p -e"
-  "*Options for the bogofilter program. Since we use bogofilter as a
-filter, '-p' must be one of the options, while '-e' tells bogofilter
-that it is embedded, and thus should not signal spam/ham with return
-values.
+  "*Bogofilter program options.
+Since we use bogofilter as a filter, '-p' must be one of the
+options, while '-e' tells bogofilter that it is embedded, and
+thus should not signal spam/ham with return values.
 * The flag '-u' controls if bogofilter automatically learns from its own
-classification. You may not want to use this flag if bogofilter still is
+classification.  You may not want to use this flag if bogofilter still is
 learning to classify, or if you do not have the discipline to correct every
 mis-classification."
   :group 'vm-bogofilter
   :type 'string)
 
 (defcustom vm-bogofilter-program-mbox "-M"
-  "*Options for the bogofilter program. This flags tells bogofilter
-how to process mailboxes, i.e., multiple messages."
+  "*Bogofilter program mailbox option.
+This flags tells bogofilter how to process mailboxes, i.e., multiple messages."
   :group 'vm-bogofilter
   :type 'string)
 
 (defcustom vm-bogofilter-program-options-unspam "-Sn"
-  "*Options for the bogofilter program when declaring a spam-marked
-message as clean. The default, '-Sn', assumes that bogofilter already
-has trained itself on the message, e.g. by running it with '-u' during
-classification. If this is the initial training, use '-n' instead."
+  "*Bogofilter program option for declaring a spam-marked message as clean.
+The default, '-Sn', assumes that bogofilter already has trained
+itself on the message, e.g. by running it with '-u' during
+classification.  If this is the initial training, use '-n'
+instead."
   :group 'vm-bogofilter
   :type 'string)
 
 (defcustom vm-bogofilter-program-options-spam "-Ns"
-  "*Options for the bogofilter program when declaring a clean-marked
-message as spam. The default, '-Ns', assumes that bogofilter already
-has trained itself on the message, e.g. by running it with '-u' during
-classification. If this is the initial training, use '-s' instead."
+  "*Bogofilter program option for declaring a clean-marked message as spam.
+The default, '-Ns', assumes that bogofilter already has trained
+itself on the message, e.g. by running it with '-u' during
+classification.  If this is the initial training, use '-s'
+instead."
   :group 'vm-bogofilter
   :type 'string)
 
 (defcustom vm-bogofilter-program-options-reclassify "-p -e"
-  "*Options for the bogofilter program when declaring a clean-marked
-message as spam.
-*See vm-bogofilter-program-options for a discussion of the options."
+  "*Bogofilter program option for declaring a clean-marked message as spam.
+See vm-bogofilter-program-options for a discussion of the options."
   :group 'vm-bogofilter
   :type 'string)
 
@@ -239,18 +248,20 @@
   :type 'string)
 
 (defcustom vm-bogofilter-formail-program-options "-s"
-  "*Options for the 'vm-bogofilter-formail-program'. After this
-arguments, the name of the bogofilter program will be passed."
+  "*Options for the 'vm-bogofilter-formail-program'.
+After this arguments, the name of the bogofilter program will be passed."
   :group 'vm-bogofilter
   :type 'string)
 
 (defcustom vm-bogofilter-invoke-through-vm t
-  "*When true, bogofilter will be invoked through the
-vm-retrieved-spooled-mail-hook. If you have procmail or some other
-MTA configured to filter through bogofilter already, then set this to
-nil to speed vm-startup.
-*NOTE: This variable is only consulted on startup, so if you change
-it, it will take effect the next time vm-bogofilter is loaded, or
+  "*Whether to invoke bogofilter through vm-retrieved-spooled-mail-hook.
+When true, bogofilter will be invoked through the
+vm-retrieved-spooled-mail-hook.  If you have procmail or some other MTA
+configured to filter through bogofilter already, then set this to nil to
+speed vm-startup.
+
+*NOTE: This variable is only consulted on startup, so if you change it,
+it will take effect the next time vm-bogofilter is loaded, or
 vm-bogofilter-setup is called."
   :group 'vm-bogofilter
   :type 'boolean)
@@ -263,8 +274,8 @@
   :type 'boolean)
 
 (defun vm-bogofilter-arrived-message ()
-  "The function used to do the actual filtering. It is used as a value for
-vm-retrieved-spooled-mail-hook."
+  "Function used to do the actual filtering.
+It is used as a value for vm-retrieved-spooled-mail-hook."
   (save-excursion
     (vm-save-restriction
      (let ((tail-cons (vm-last vm-message-list))
@@ -295,7 +306,7 @@
   )
 
 (defun vm-bogofilter-is-spam-old ()
-  "Declare that a clean-marked message is spam"
+  "Declare that a clean-marked message is spam."
   (interactive)
   (vm-follow-summary-cursor)
   (vm-pipe-message-to-command
@@ -303,7 +314,7 @@
   )
 
 (defun vm-bogofilter-is-clean-old ()
-  "Declare that a spam-marked message is clean"
+  "Declare that a spam-marked message is clean."
   (interactive)
   (vm-follow-summary-cursor)
   (vm-pipe-message-to-command
@@ -311,15 +322,15 @@
   )
 
 (defun vm-bogofilter-is-spam ()
-  "Declare that a clean-marked message is spam, and re-tag message"
+  "Declare that a clean-marked message is spam, and re-tag message."
   (interactive)
   (vm-bogofilter-retag "spam" vm-bogofilter-program-options-reclassify vm-bogofilter-program-options-spam)
   (if vm-bogofilter-delete-spam
-      (vm-delete-message 1)) 
+      (vm-delete-message 1))
   )
 
 (defun vm-bogofilter-is-clean ()
-  "Declare that a spam-marked message is clean, and re-tag message"
+  "Declare that a spam-marked message is clean, and re-tag message."
   (interactive)
   (vm-bogofilter-retag "clean" vm-bogofilter-program-options-reclassify vm-bogofilter-program-options-unspam)
   )
@@ -374,15 +385,13 @@
 	)))))
 
 ;;; Hooking into VM
-
+;;;###autoload
 (defun vm-bogofilter-setup ()
   "Initialize vm-bogofilter."
   (interactive)
   (if vm-bogofilter-invoke-through-vm
       (add-hook 'vm-retrieved-spooled-mail-hook 'vm-bogofilter-arrived-message)
       (remove-hook 'vm-retrieved-spooled-mail-hook 'vm-bogofilter-arrived-message)))
-
-(vm-bogofilter-setup)
   
 (provide 'vm-bogofilter)
 
emacs-goodies-el-35.8ubuntu2/debian/gnus-bonus-el.emacsen-install.in0000775000000000000000000000136112230377266022345 0ustar  #! /bin/bash -e
# /usr/lib/emacsen-common/packages/install/gnus-bonus-el

# Written by Jim Van Zandt , borrowing heavily
# from the install scripts for gettext by Santiago Vila
#  and octave by Dirk Eddelbuettel .

FLAVOR=$1
PACKAGE=gnus-bonus-el
STAMPFILE=gnus-junk.elc
APPEND_LOAD_PATH="'(\"/usr/share/emacs/site-lisp/gnus/lisp/\")"

# INCLUDED_emacs20=""
# INCLUDED_emacs21=""
# INCLUDED_xemacs21=""

# EXCLUDED_emacs20=""
# EXCLUDED_emacs21=""
# EXCLUDED_xemacs21=""
EXCLUDED_emacs_snapshot="nnnil.el spam-stat.el"
EXCLUDED_emacs22="nnnil.el spam-stat.el"
EXCLUDED_emacs23="nnnil.el spam-stat.el"

if [ ${FLAVOR} = emacs20 ]; then 
    echo "Skipping byte-compilation for emacs20"
    exit 0;
fi
emacs-goodies-el-35.8ubuntu2/debian/dpkg-dev-el.README.Debian0000775000000000000000000000303412230377266020377 0ustar    This file is an introductory starter for the various goodies included in
dpkg-dev-el.  It does not intend to replace reading the documentation that
is made available in the files themselves (or not available at all, except
insofar as code is self-documenting).

To customize all files in this package, use:

 M-x customize-group [RET] dpkg-dev-el [RET]

Introduction to files in dpkg-dev-el
------------------------------------

debian-bts-control.el provides an interface for composing email messages to
the Debian BTS control interface (control@bugs.debian.org).  Tab completions
works for all possible commands and their options.

debian-changelog-mode.el provides a mode for editing debian/changelog
files.  This mode adds colouring, a few commands to manipulate
changelog entries and bug reports, and a nice filling function.  This
mode can also be used to add colours to buffers visiting the
changelogs in /usr/share/doc//changelog.Debian files.

debian-copyright.el provides a mode for editing debian/copyright files.
This mode adds a bit of colouring and if `goto-addr' is loaded, it will
make the URLs clickable.

debian-control-mode.el provides a mode for editing debian/control
files.  This mode adds a bit of colouring, a working filling function
(bound to "M-q" by default), tab-completion for adding fields (bound
to "C-c C-a" by default), and viewing bugs (bound to "C-c C-b").

readme-debian.el provides readme-debian-mode, a major mode to
highlight README.Debian files.

 -- Peter S Galbraith , Mon Oct 24 21:08:04 2005
emacs-goodies-el-35.8ubuntu2/debian/devscripts-el.emacsen-remove.in0000775000000000000000000000014612230377266022262 0ustar  #!/bin/sh -e
# /usr/lib/emacsen-common/packages/remove/devscripts-el

FLAVOR=$1
PACKAGE=devscripts-el
emacs-goodies-el-35.8ubuntu2/debian/debian-el.README.Debian0000775000000000000000000000250512230377266020122 0ustar    The file you're currently reading is mostly meant as an introductory
starter for the various goodies included in debian-el.  Consult the Info
node `debian-el' for more complete information.

To customize all files in this package, use:

 M-x customize-group [RET] debian-el [RET]


Introduction to files in debian-el
----------------------------------

apt-sources.el provides apt-sources-mode, a major mode to help the
edition of /etc/apt/sources.list (and suchlike) files.  To use it,
either open a file named sources.list and it will be autoloaded, or
add a local variables section to the end of your file to specify the
mode to be "apt-sources".

apt-utils.el provides an interface to APT. Start things off using e.g.:
M-x apt-utils-show-package RET emacs21 RET

debian-bug.el provides M-x debian-bug (and variants), to submit bugs
to the Debian bug tracking system.

deb-view.el presents the contents of debian package archive files for
viewing (similar to tar-mode).

gnus-BTS.el makes bug numbers clickable in messages viewed in Gnus.
It expects to see bug references in the form of (for example):
"#48273", "closes: 238742" or similar.  To use, add the following to
your .gnus: "(require 'gnus-BTS)".

preseed.el is a major mode for editing debian-installer preseed files.

 -- Peter S Galbraith , Mon Oct 24 21:10:25 2005
emacs-goodies-el-35.8ubuntu2/debian/debian-el.emacsen-install.in0000775000000000000000000000224212230377266021466 0ustar  #! /bin/bash -e
# /usr/lib/emacsen-common/packages/install/debian-el

# Written by Jim Van Zandt , borrowing heavily
# from the install scripts for gettext by Santiago Vila
#  and octave by Dirk Eddelbuettel .
#
# Patched by Roland Mas  to add support for lists of
# flavor-dependently included/excluded files and by Peter S Galbraith
#  to add a STAMPFILE (to only byte-compile once) and
# APPEND_LOAD_PATH ton augment the load-path for byte-compilation.

FLAVOR=$1
PACKAGE=debian-el
STAMPFILE=debian-el.elc

# INCLUDED_emacs20=""
# INCLUDED_emacs21=""
# INCLUDED_xemacs21=""
# INCLUDED_emacs_snapshot=""

# EXCLUDED_emacs20=""
# EXCLUDED_emacs21=""
# EXCLUDED_xemacs21=""
# EXCLUDED_emacs_snapshot=""

# Don't byte-compile gnus-BTS.el since it uses gnus macros and will break
# if compiled and then used with different versions of gnus (e.g. as
# shipped wth Emacs vs package separately).
SOURCEONLY_emacs20="gnus-BTS.el"
SOURCEONLY_emacs21="gnus-BTS.el"
SOURCEONLY_emacs22="gnus-BTS.el"
SOURCEONLY_emacs23="gnus-BTS.el"
SOURCEONLY_xemacs21="gnus-BTS.el"
SOURCEONLY_emacs_snapshot="gnus-BTS.el"
emacs-goodies-el-35.8ubuntu2/debian/vm-bonus-el.install0000775000000000000000000000011312230377266017767 0ustar  elisp/vm-bonus-el/vm-bogofilter.el /usr/share/emacs/site-lisp/vm-bonus-el/
emacs-goodies-el-35.8ubuntu2/debian/devscripts-el.emacsen-install.in0000775000000000000000000000130112230377266022425 0ustar  #! /bin/bash -e
# /usr/lib/emacsen-common/packages/install/devscripts-el

# Written by Jim Van Zandt , borrowing heavily
# from the install scripts for gettext by Santiago Vila
#  and octave by Dirk Eddelbuettel .
#
# Patched by Roland Mas  to add support for lists
# of flavor-dependently included/excluded files

FLAVOR=$1
STAMPFILE=devscripts.elc
# We need elserv, flim, apel, etc.  So use full Debian setup of packages
FLAGS="-q -batch -l path.el -f batch-byte-compile"
PACKAGE=devscripts-el

# INCLUDED_emacs20=""
# INCLUDED_emacs21=""
# INCLUDED_xemacs21=""

# EXCLUDED_emacs20=""
# EXCLUDED_emacs21=""
# EXCLUDED_xemacs21=""
emacs-goodies-el-35.8ubuntu2/debian/README.Debian0000775000000000000000000003255312230377266016311 0ustar  Emacs Goodies for Debian
------------------------

  The file you're currently reading is mostly meant as an introductory
starter for the various goodies included in emacs-goodies-el.  Consult the
Info node `emacs-goodies-el' for more complete information.


Introduction to files in emacs-goodies-el
-----------------------------------------

,----[ nice title ]
| boxquote.el allows the easy creation of boxes that look like this,
| with a nice title and all.  Look for the M-x boxquote-* commands.
`----

align-string.el provides M-x align-string and M-x align-all-strings,
to align vertically the first occurences of a regexp over several
lines.

all.el provides M-x all, a way to see all lines matching a regexp
pattern in a special buffer.  Editing these lines in that buffer
propagates the changes back to the original buffer.

apache-mode.el provides fontification when editing Apache configuration
files.

ascii.el provides a way to display ASCII code on a window, that is, display
in another window an ASCII table highlighting the current character code.

auto-fill-inhibit.el provides a finer grained control over
auto-fill-mode activation.  Tu use it, simply load the file.  For
instance, adding (load-library "auto-fill-inhibit") to your .emacs
should do the trick.  You'll need to set the auto-fill-inhibit-list
variable to an appropriate value.

bar-cursor.el allows you to change your cursor from a block to a
vertical bar in insert mode, and back to a block in overwrite mode.
Try M-x bar-cursor-mode.

bm.el provides visible, buffer local, bookmarks and the ability to jump
forward and backward to the next bookmark.

browse-huge-tar.el allows you to browse large tar files without reading
them into memory.  The trade off is memory usage vs. speed.

browse-kill-ring.el provides M-x browse-kill-ring.el, to, well, browse
through your kill ring, perform searches on it, and insert items into
a buffer.

cfengine.el is an Emacs major-mode for editing cfengine scripts.

clipper.el provides the M-x clipper-* commands to save strings of data
and insert them afterwards.  Each string is labeled with a name, and
can involve some basic template replacement.

color-theme.el changes the colors used within Emacs.  They are lots of
themes to choose from.

csv-mode.el is a major mode for editing files of CSV type, which provides
commands, key bindings and a menu to sort records by field, kill and yank
columns, align and unalign fields, and transpose rows and columns.

ctypes.el can search through source files hunting down typedefs.  When
found, font-lock is informed and your source code will be even more
beautifully colored than before.

coffee.el provides an Emacs interface to RFC2324-compliant coffee
devices

dedicated.el allows you to toggle a window's "dedicated" flag.
When a window is "dedicated", Emacs will not select files into that window.

df.el provides M-x df, to display in the mode line space left on
devices.

dict.el is an Emacs wrapper around `dict' command to provide access to
a dictd server from within Emacs.  The package provides several
(customisable) key bindings, here are two of the default ones: `C-c d
d' runs dict on the word at point.  `C-c d r' runs dict on region as a
single word.

diminish.el provides M-x diminish, M-x diminish-undo and M-x
diminished-modes.  Diminished modes are minor modes with a shorter or
no modeline display.

dir-locals.el provides a functionality similar to the local variables
defined in a file, but for an entire directory tree.  Use This library
implements such a scheme, controlled by the global minor mode
`dir-locals-mode'.

edit-env.el lets you display, edit, delete and add environment variables.

egocentric.el provides M-x egocentric-mode, a mode to highlight your
name (or other keywords) in buffers.  If you use Gnus, you might want
to add (add-hook 'gnus-article-prepare-hook 'egocentric-mode) to your
Gnus init file.

eproject.el is an extension that lets you group related files together as
projects.  It aims to be as unobtrusive as possible -- no new files are
created (or required to exist) on disk, and buffers that aren't a member of
a project are not affected in any way.

ff-paths.el allows you to use C-x C-f normally most of the time,
except that if the requested file doesn't exist, it is checked against
a list of patterns for special paths to search for a file of the same
name.  Use (require 'ff-paths) in your .emacs to activate it.

filladapt.el enhances the behavior of Emacs's fill functions by
guessing the proper fill prefix in many contexts.  Emacs has a
built-in adaptive fill mode but Filladapt is said to be much better.
Use `M-x filladapt-mode' to toggle Filladapt mode on/off in the current
buffer.  Use 'turn-on-filladapt-mode in mode hooks.

folding.el provides a minor mode for folding (hiding) parts of the edited
text or program.  Folding mode handles a document as a tree, where each
branch is bounded by special markers `{{{' and `}}}'.

framepop.el makes temporary buffers such as *Help* or *Completions* appear
in a separate frame which is easily dismissed when no longer needed.

floatbg.el provides M-x floatbg-mode, to slowly modify the background
color of your Emacs.

graphviz-dot-mode.el provides a mode for editing files in the dot-language
(www.graphviz.org and http://www.research.att.com/sw/tools/graphviz/).

highlight-beyond-fill-column.el highlights (with a face you choose) text
that is beyond the fill-column, therefore providing a visual indication of
where the fill-* functions would wrap the lines.  Enable it on a buffer
using `M-x highlight-beyond-fill-column.'  You may use that command in a
hook (e.g. text-mode-hook)

highlight-current-line.el highlights the line the cursor is in.  Enable a
buffer using the command `M-x highlight-current-line-minor-mode'. You may
enable the minor-mode automatically for (almost) all buffers by

home-end.el provides some useful bindings for Home and End keys: hit the
key once to go to the beginning/end of a line, hit it twice in a row to go
to the beginning/end of the window, three times in a row goes to the
beiginning/end of the buffer.  To enable it, customize the variable
`home-end-enable'.

htmlize.el provides many M-x htmlize-* commands that turn files,
buffers, or region of font-lock colorised text into an HTML
representation.

initsplit.el allows you to split Emacs customizations (set via M-x
customize) into different files, based on the names of the variables.
To use it, just load the file in your .emacs: (load "initsplit").
Note that that you *must* load each file that contains your various
customizations from your .emacs.

joc-toggle-buffer.el provides M-x joc-toggle-buffer, a command that can be
bound to a key in order to speed up the switching between two buffers.

joc-toggle-case.el provides a sophisticated (over-engineered?) set of
functions to toggle the case of the character under point, with which
you can emulate vi's ~ function.  Look for the M-x joc-toggle-case and
M-x joc-toggle-case-* commands.

keydef.el provides the `keydef' macro for use in .emacs files (or
similar).  It is an alternative (simpler) way to define keys, with kbd
syntax.  You should read the doc in keydef.el, as it is not intended
for interactive use.

keywiz.el drills you about Emacs key-bindings.  You're presented with
the name of a command and the docstring, and then prompted for the
correct key sequence.  You'll earn one point for each correct answer
during the time limit.  Invoke with `M-x keywiz'.

lcomp.el adds useful keybindings to the completions buffer.

maplev.el is a major mode for Maple.

map-lines.el provides M-x map-lines, a command to iterate a given
command over lines matching a regexp.

markdown-mode.el provides support for editing Markdown files. It
provides syntax highlighting and basic element insertion commands.

marker-visit.el provides a simple way to navigate among marks in a buffer.
All the marks you've left while editing a buffer serve as bread crumb
trails of areas in the buffer you've edited.  It is convenient to navigate
back and forth among these marks in order.  This file provides two methods
to do just that, marker-visit-prev and marker-visit-next to visit the
nearest mark in either direction.

matlab.el provides support for editing MATLAB dot-m files.  It
automatically indents for block structures, line continuations (e.g., ...),
and comments.

minibuf-electric.el eases minibuffer typing.  When you type "//", it clears
the minibuffer back to the start, leaving only a single "/".  When you type
a "~", it does the similar, leaving only "~/".  This is nicer than having
to explicitly erase the contents of the minibuffer.

minibuffer-complete-cycle.el makes `minibuffer-complete' select each of the
possible completions in turn, inserting it into the minibuffer and
highlighting it in the *Completions* buffer.

miniedit.el toggles minibuffer editing into a full text-mode buffer for
easy multi-line editing of commands.

mutt-alias.el provides M-x mutt-alias-insert and M-x
mutt-alias-lookup, two commands to lookup and insert the expansion of
mutt mail aliases.

muttrc-mode.el provides muttrc-mode, a major mode to help the edition
of Mutt configuration files.  To use it, either open a file named
muttrc, or add a local variables section to the end of your file to
specify the mode to be "muttrc".

obfusurl.el provides M-x obfuscate-url, a command that will obfuscate
an URL under the cursor.

pack-windows.el resizes all windows vertically to display as much
information as possible with the command `M-x pack-windows'.

perldoc.el provides an interface to the "perldoc" command in your
Perl-mode or CPerl-mode buffers.  Use (require 'perldoc) in your
.emacs to activate it, then place point over a word and press F1.

pp-c-l displays Control-l characters in a pretty way.

pod-mode.el provides support for editing Plain Old Documentation
(Perl documentation) files.  It provides syntax highlighting.

projects.el provides M-x add-project, remove-project and
list-projects, and introduces the concept of PROJECT ROOTS that allow
the user to define logical project names and get abbreviated yet
meaningful buffer names in the modeline.

protbuf.el provides M-x protect-buffer-from-kill-mode and M-x
protect-process-buffer-from-kill-mode, two commands to protect buffers
from being accidentally killed.

protocols.el provides M-x protocols-lookup, to search for info in your
/etc/protocols.

quack.el provides enhanced support for editing and running Scheme code
in both the major and minor modes. It also provides easy access to online
references for plt-scheme, books on Scheme, and SRFIs (Scheme Requests
For Implementation). Because it invasively changes scheme-mode, it is
not enabled by default. To enable it, customize the variable `quack-install'.

rfcview.el formats IETF RFCs for improved readability.

services.el provides M-x services-lookup, to search for info in your
/etc/services.

session.el restores various variables (e.g., input histories) from your
last session.  It also provides a menu containing recently changed/visited
files and restores the places (e.g., point) of such a file when you revisit
it.

setnu.el provides M-x setnu-mode, a vi-style line number mode.

shell-command.el is an an enhancement for shell-command, enabling
tab-completion of commands and dir/filenames within the shell-command input
context.

show-wspace.el is a minor mode to highlight whitespaces of various kinds.

slang-mode.el is a major mode for editing S-Lang files.

silly-mail.el provides M-x add-sm-* commands to add various headers to
your email messages.

sys-apropos.el provides M-x sys-apropos, an interface to the "apropos"
command.

tabbar.el displays buffers as tabs in the header line, and provides commands
to switch between them.  You can bind keys to M-x tabbar-forward and M-x
tabbar-backward, and use these to quickly switch between buffers.  By default,
tabbar-mode will group buffers into various groups, and only display one group
at a time on the tabbar; you can change this by customizing tabbar.

tail.el provides the commands M-x tail-file and M-x tail-command, to
follow the output of a command (or to follow a log file) without using
any terminals.

tc.el provides a nice way to quote cited texts, with proper filling
and attribution.  You can use it for instance by setting the cite
function to 'trivial-cite: (setq message-cite-function 'trivial-cite).


thinks.el provides cartoon-like think bubbles . o O ( like this ).
Look for M-x thinks* commands.

tlc.el is a major mode for editing Target Language Compiler scripts.  It
automatically indents the programming constructs.

tld.el provides M-x tld, for easy access to all those top-level
domains you just can't remember, and to the corresponding countries.

todoo.el provides M-x todoo and M-x todoo-mode, to conveniently edit
TODO lists.

toggle-option.el provides M-x toggle-option, a command to rapidly
toggle an option.  You should set the toggle-option-list variable to
an appropriate value.

twiddle.el provides mode-line hacks.  There are two user commands of
interest: twiddle-start and twiddle-compile.

under.el provides M-x underline-region, to underline a bit of text
with ^ characters like this.
                  ^^^^^^^^^
upstart-mode.el is a major-mode for editing .upstart files.

xrdb-mode.el provides the xrdb-mode major mode, to help you editing X
resource database files.  To use it, simple open a file named .Xdefaults,
.Xenvironment, .Xresources or *.ad after having enabled it by customising
`xrdb-mode-setup-auto-mode-alist'.

 -- Peter S Galbraith , Tue, 16 Aug 2011 12:09:31 -0400
emacs-goodies-el-35.8ubuntu2/debian/vm-bonus-el.copyright0000775000000000000000000000310412230377266020334 0ustar  This package was first debianized by Peter S Galbraith 

All Debian packaging code is:
  Copyright (c) 2009 Peter S Galbraith 

  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 2 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 with
  the Debian GNU/Linux distribution in file /usr/share/common-licenses/GPL-2;


Copyright information for vm-bogofilter.el:

,----
| ;;; vm-bogofilter.el --- Interfaces VM with the bogofilter spam filter.
| ;;
| ;; Copyright (C) 2003-2006 by Bjorn Knutsson
| ;;
| 
| ;; Based on vm-spamassassin.el v1.1, Copyright (C) 2002 by Markus Mohnen
| ;;
| ;;
| ;; 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 2 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.
`----
emacs-goodies-el-35.8ubuntu2/debian/dpkg-dev-el.copyright0000775000000000000000000000627712230377266020305 0ustar  This package was first debianized by Roland Mas 
It is currently maintained by Peter S Galbraith 

  This collection of files was assembled by Roland Mas 
from various messages posted on the gnu.emacs.sources newsgroup, as well as
from various collections of Emacs Lisp files found on the web.  Some
authors contacted Roland directly, some users sent me the files by email.
Most of them are covered by the GNU GPL, but the individual licences can
vary.  Here is a list of excerpts of the included files covering this
matter.

  The text of the GNU GPL can be found in /usr/share/common-licenses.

Copyright info for files in dpkg-dev-el
---------------------------------------

Author/copyright info for debian-bts-control.el
,-
| ;; Copyright (C) 2003 Peter S Galbraith
| ;;
| ;; This file 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 2, or (at your option)
| ;; any later version.
| ;;
| ;; debian-bts-mode.el 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.
`-


Author/copyright info for debian-changelog-mode.el:
,----
| Copyright (C) 1996 Ian Jackson
| Copyright (C) 1997 Klee Dienes
| Copyright (C) 1999 Chris Waters
| Copyright (C) 2000 Peter S Galbraith
| 
| It 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 2, or (at your option)
| any later version.
`----


Author/copyright info for debian-control-mode.el:
,----
| ;;; debian-control-mode.el --- major mode for Debian control files
| 
| ;; Copyright (C) 2001 Free Software Foundation, Inc.
| 
| ;; Author: Colin Walters 
| ;; Maintainer: Colin Walters 
| [...]
| ;; This file 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for debian-copyright.el
,-
| ;; Copyright 2002, 2003 Junichi Uekawa.
| 
| ;; This file 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 2, or (at your option)
| ;; any later version.
| ;;
| ;; debian-copyright.el 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.
`-


Author/copyright info for readme-debian.el:
,----
| ;; Copyright 2002 Junichi Uekawa.
| 
| ;; This file 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 2, or (at your option)
| ;; any later version.
`----
emacs-goodies-el-35.8ubuntu2/debian/vm-bonus-el.README.Debian0000775000000000000000000001026312230377266020446 0ustar  This is an introductory starter for the various goodies included in
vm-bonus-el.

You may customize files in this package by using:

 M-x customize-group [RET] vm-bonus-el [RET]

------------------------------------
Introduction to files in vm-bonus-el
------------------------------------

vm-bogofilter.el
----------------

Installation:

 Put this file on your Emacs-Lisp load path and add following into your
 ~/.vm startup file

     (require 'vm-bogofilter)
     (vm-bogofilter-setup)

 Or, alternatively on Debian, customize `vm-bogofilter-setup' to t:

  M-x customize-variable [RET] vm-bogofilter-setup [RET]

Usage:

Whenever you get new mail bogofilter will be invoked on them. Mail
detected as spam will be tagged by bogofilter, and you can use
existing mechanisms to dispose of them.

For example, if you append this line to your .vm (or modify your
existing auto-folder-alist), you could then have messages tagged as
spam automatically saved in a separate 'spam' folder:

(setq vm-auto-folder-alist '(("^X-Bogosity: " ("Yes," . "spam"))))

If you want your auto-folder to be used every time you've received
new mail, just add the following to your .vm:

(add-hook 'vm-arrived-messages-hook 'vm-auto-archive-messages)

You can also set (setq 'vm-delete-after-archiving t) to make VM
automatically delete archived spams from the main folder.


If a message is tagged as spam incorrectly, you can re-train
bogofilter by calling the function vm-bogofilter-is-clean on that
message. Similarly, calling vm-bogofilter-is-spam will re-train
bogofilter to recognize a clean-marked message as spam.

These functions can be bound to keys in your .vm, for example:

(define-key vm-mode-map "K" 'vm-bogofilter-is-spam)
(define-key vm-mode-map "C" 'vm-bogofilter-is-clean)

would define K (shift-k) as the key to declare the current message
as spam, while C (shift-c) as the key to declare the current
message as clean.

Re-training with the old functions (still available) would not
re-tag messages, while the new ones will. Re-training may or may
not change the spam-status of a message. Because of the way
bogofilter works, even a message explicitly declared as spam may
not be tagged as spam if there are enough similar non-spam
messages. Remember, bogofilter is not trained to recognize
individual messages, but rather patterns. You may have to train
bogofilter on a number of spam messages before it recognizes any of
them as spam. See the documentation for bogofilter. Notice also
that even if the tag changes, this will not undo actions previously
taken based on the tag, e.g. moving spam to a spamfolder with
auto-folders.

If you have a small database, running bogofilter without '-u' may
be better in the beginning. If you want to run without '-u', it
can easily be accomplished. Just:

M-x customize vm-bogofilter

Then change the Program Options to just '-p -e' and the Unspam to
'-n' and Spam to '-s'.

Now, bogofilter will not auto-train, and you must instead use the
vm-bogofilter-is-spam and vm-bogofilter-is-clean to manually tag
messages. (If you've bound them to keys, it will be quite simple.)

BUGS:

One know bug is that formail will not like it if the input is not
in the format it expects and knows. Even though it's supposed to
know BABYL, this does not work.

A related problem is that if you have the wrong folder type
selected, then sometimes, VM will merge messages. You can check the
raw folder to see if you have a blank line before the "From "-line
separating messages. See the documentation for vm-default-folder-type

vm-bogofilter is not very smart about errors. If an error occurs
during any operation that tags or re-tags messages, the message(s)
being processed will be *lost*. If errors occur during initial
processing, the lost mails can sometimes be recovered since VM will
save the folder *after* receiving new mails, but *before*
processing hooks, e.g. vm-bogofilter. If you notice the errors
before saving the folder, you can copy the old file, close VM,
rename your copy to the original folder name and then start VM
again. Naturally, anything that happened to the folder after
fetching new mail will be lost, e.g. bogofilter tagging etc.


 -- Peter S Galbraith , Sat, 14 Nov 2009 13:49:02 -0500
emacs-goodies-el-35.8ubuntu2/debian/emacs-goodies-el.copyright0000775000000000000000000012030312230377266021306 0ustar  This package was first debianized by Roland Mas 
It is currently maintained by Peter S Galbraith 

  This collection of files was assembled by Roland Mas 
from various messages posted on the gnu.emacs.sources newsgroup, as well as
from various collections of Emacs Lisp files found on the web.  Some
authors contacted Roland directly, some users sent me the files by email.
Most of them are covered by the GNU GPL, but the individual licences can
vary.  Here is a list of excerpts of the included files covering this
matter.

  The text of the GNU GPL can be found in /usr/share/common-licenses.

Copyright info for files in emacs-goodies-el
--------------------------------------------

Author/copyright info for align-string.el:
,----
| ;; Copyright (c) 2001 Markus Bjartveit Krüger
|
| ;; Author:   Markus Bjartveit Krüger 
| [...]
| ;; X-URL:    http://www.pvv.org/~markusk/align-string.el
|
| ;; This 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for all.el:
,----
| ;;; all.el --- Edit all lines matching a given regexp.
|
| ;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
| ;; Copyright (C) 1994 Per Abrahamsen
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for apache-mode.el
from http://www.emacswiki.org/elisp/apache-mode.el
,----
| ;;; apache-mode.el --- major mode for editing Apache configuration files
|
| ;; Author:    Jonathan Marten  
| ;; Author:    Karl Chen 
| [...]
| ;;
| ;; It 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for ascii.el:
,----
| ;;; ascii --- ASCII code display.
| 
| ;; Copyright (C) 1999, 2000, 2001 Vinicius Jose Latorre
| 
| ;; 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 2, or (at your option) any later
| ;; version.
`----


Author/copyright info for auto-fill-inhibit.el:
,----
| ;;; auto-fill-mode-inhibit -- finer grained control over
| ;;;     auto-fill-mode (de)activation
| ;;; Copyright (c) 2001 Michael Weber 
| [...]
| ;;; This program is free software; you can redistribute it and/or
| ;;; modify it under the terms of the GNU General Public License
| ;;; version 2 as published by the Free Software Foundation.
| [...]
| ;;; NO-VIRUS CLAUSE:
| ;;; The intent of this license is to protect free redistribution and
| ;;; reuse of the source of the licensed distribution, not to prejudice
| ;;; the authorship rights of programmers of other code to control
| ;;; their original inventions.
| ;;;
| ;;; No portion of this license is to be interpreted as forbidding the
| ;;; reuse of this code or its constituent parts, algorithms, or
| ;;; inventions in commercial products.
| ;;;
| ;;; Nor shall such inclusion be construed to require the GPLing or
| ;;; disclosure of any portions of said commercial products other than
| ;;; those falling under the copyright of the licensed distribution.
`----


Author/copyright info for bar-cursor.el:
,----
| ;;; @(#) bar-cursor.el -- package used to switch block cursor to a bar
| [...]
| ;; Copyright (C) 2001 by Joseph L. Casadonte Jr.
| ;; Author:          Joe Casadonte (emacs@northbound-train.com)
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----

Author/copyright info for bm.el:
,----
| ;; Copyrigth (C) 2000-2010  Jo Odland
| 
| ;; Author: Jo Odland 
| 
| ;; Portions Copyright (C) 2002 by Ben Key
| ;; Updated by Ben Key  on 2002-12-05
| ;; to add support for XEmacs
| 
| ;; 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 2, or (at
| ;; your option) any later version.
`----


Author/copyright info for boxquote.el:
,----
| ;;; boxquote.el --- Quote text with a semi-box.
| ;; Copyright 1999-2009 by Dave Pearson 
| ;; $Revision: 1.37 $
| 
| ;; boxquote.el is free software distributed under the terms of the GNU
| ;; General Public Licence, version 2 or (at your option) any later version.
`----


Author/copyright info for browse-huge-tar.el:
,----
| ;;; browse-huge-tar.el --- Browse files in a tarball memory-efficiently.
| ;; (c) Gareth Owen 1999 (hey I just typed `space' 1999.  Ho ho.)
| 
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for browse-kill-ring.el:
,----
| ;;; browse-kill-ring.el --- interactively insert items from kill-ring
|
| ;; Copyright (C) 2001 Colin Walters
| [...]
| ;; 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 2, or (at
| ;; your option) any later version.
`----


Author/copyright info for cfengine.el
http://www.loveshack.ukfsn.org/emacs/cfengine.el
,----
;;; cfengine.el --- mode for editing Cfengine files
|
|;; Copyright (C) 2003, 2004, 2005  Free Software Foundation, Inc.
|
|;; Author: Dave Love 
|
|;; 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 2, or (at your option)
|;; any later version.
`----


Author/copyright info for clipper.el:
,----
| ;;; clipper.el --- save strings of data for further use.
|
| ;; Copyright (C) 1997-2000 Free Software Foundation, Inc.
|
| ;; Author: Kevin A. Burton (burton@openprivacy.org)
| ;; Maintainer: Kevin A. Burton (burton@openprivacy.org)
| ;; Location: http://relativity.yi.org
| [...]
| ;; This file is [not yet] part of GNU Emacs.
|
| ;; 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 2 of the License, or any later version.
`----


Author/copyright info for csv-mode.el:
 http://centaur.maths.qmul.ac.uk/Emacs/
 http://centaur.maths.qmul.ac.uk/Emacs/files/csv-mode.el
,----
| ;;; csv-mode.el --- major mode for editing comma-separated value files
| 
| ;; Copyright (C) 2003, 2004 Francis J. Wright
| 
| ;; Author: Francis J. Wright 
| [...]
| ;; This package 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for ctypes.el:
,----
| ;;; ctypes.el --- Enhanced Font lock support for custom defined types.
| 
| ;; Copyright (C) 1997, 1999 Anders Lindgren.
| 
| ;; Author: Anders Lindgren 
| [...]
| ;; CTypes 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for coffee.el:
,----
| ;;; coffee.el --- Submit a BREW request to an RFC2324-compliant coffee device
| ;;;
| ;;; Author: Eric Marsden 
| ;;; Version: 0.3
| ;;; Copyright: (C) 1999, 2003 Eric Marsden
| ;;; Keywords: coffee brew kitchen-sink can't
| ;;
| ;;
| ;;     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 2 of
| ;;     the License, or (at your option) any later version.
`----


Author/copyright info for color-theme.el
,----
| ;;; color-theme.el --- install color themes
| 
| ;; Copyright (C) 1999, 2000  Jonadab the Unsightly One 
| ;; Copyright (C) 2000, 2001, 2002, 2003  Alex Schroeder 
| ;; Copyright (C) 2003, 2004  Xavier Maillard 
| 
| ;; Author: Jonadab the Unsightly One 
| ;; Maintainer: Xavier Maillard 
| ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorTheme
| 
| ;; This 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 2, or (at your option) any later
| ;; version.
`----


Author/copyright info for dedicated.el:
,----
| ;;; dedicated.el --- A very simple minor mode for dedicated buffers
| 
| ;; Copyright (C) 2000 Eric Crampton 
| 
| ;; This 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 2, or (at your option) any later
| ;; version.
`----


Author/copyright info for df.el:
,----
| ;;; df.el --- Hack to display in the mode line space left on devices
|
| ;; Copyright (C) 1999 by Association April
|
| ;; Author: Benjamin Drieu 
| [...]
| ;; GNU Emacs as this program are free software; you can redistribute
| ;; them and/or modify them under the terms of the GNU General Public
| ;; License as published by the Free Software Foundation; either
| ;; version 2, or (at your option) any later version.
`----


Author/copyright info for dict.el:
,----
| ;; dict.el - Emacs interface to dict client
| ;;
|
| ;; Copyright (c) 2002 Max Vasin
| ;;
| ;; 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 2
| ;; of the License, or (at your option) any later version.
`----


Author/copyright info for diminish.el:
,----
| ;; Copyright (C) 1998 Free Software Foundation, Inc.
|
| ;; Author: Will Mengarini 
| ;; URL: 
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for dir-locals.el
,----
| ;; Copyright (C) 2005, 2006  Free Software Foundation, Inc.
| 
| ;; Author: Dave Love 
| ;; Keywords: files
| ;; $Revision: 1.37 $
| ;; URL: http://www.loveshack.ukfsn.org/emacs
| 
| ;; This file 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 2, or (at your option)
| ;; any later version.
| 
| ;; This file 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.
`----


Author/copyright info for edit-env.el:
,----
| ;;; edit-env.el --- display and edit environment variables
| 
| ;; Copyright (C) 2001 Benjamin Rutt
| 
| ;; This file 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 2, or (at your
| ;; option) any later version.
`----


Author/copyright info for egocentric.el:
,----
| ;;; @(#) egocentric.el --- highlight your name inside emacs buffers
| [...]
| ;; Copyright (C) 2001 by Benjamin Drieu
| ;; Author:	 Benjamin Drieu 
| ;; Maintainer:	 Benjamin Drieu 
| [...]
| ;; 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 2, or (at
| ;; your option) any later version.
`----

Author/copyright info for eproject.el:
,----
| ;;; eproject.el --- assign files to projects, programatically
| ;;
| ;; Copyright (C) 2008, 2009 Jonathan Rockway 
| ;;
| ;; Author: Jonathan Rockway 
| ;; Maintainer: Jonathan Rockway 
| [...]
| ;; 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 2 of
| ;; the License, or (at your option) any later version.
`----

Author/copyright info for eproject-extras.el
,----
| ;;; eproject-extras.el --- various utilities that make eproject more enjoyable
| 
| ;; Copyright (C) 2009  Jonathan Rockway
| 
| ;; Author: Jonathan Rockway 
| ;; Keywords: eproject
| 
| ;; 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.
`----


Author/copyright info for ff-paths.el:
,----
| ;;; ff-paths.el - find-file-using-paths searches certain paths to find files.
|
| ;; Copyright (C) 1994-2001 Peter S. Galbraith
|
| ;; Author:    Peter S. Galbraith 
| ;;                               
| [...]
| ;; This package 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for filladapt.el:
,----
| ;;; Adaptive fill
| ;;; Copyright (C) 1989, 1995-1998 Kyle E. Jones
| ;;;
| ;;; 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 2, or (at your option)
| ;;; any later version.
`----


Author/copyright info for floatbg.el:
,----
| ;;; floatbg.el --- slowly modify background color
| ;; Copyright (C) 2001 John Paul Wallington
| [...]
| ;; Author:  John Paul Wallington 
| [...]
| ;; 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 2, or (at
| ;; your option) any later version.
`----


Author/copyright info for folding.el
 http://cvs.sourceforge.net/viewcvs.py/tiny-tools/tiny-tools/lisp/other/
,----
| ;;; folding.el --- A folding-editor-like minor mode.
| ;; Copyright (C) 1994-2004
| ;;           Jari Aalto, Anders Lindgren, All rights reserved.
| ;; Copyright (C) 1992, 1993
| ;;           Jamie Lokier, All rights reserved.
| [...]
| ;; 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 2 of the
| ;; License, or (at your option) any later version.
`----


Author/copyright info for framepop.el
,----
| ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
| ;; Copyright (C) 2003 Peter S Galbraith
|
| ;; Author: David Smith 
| ;; Maintainer: Peter S Galbraith 
| [...]
| ;; This file 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for graphviz-dot-mode.el
,----
| ;;; graphviz-dot-mode.el --- Mode for the dot-language used by graphviz (att).
| 
| ;; Copyright (C) 2002 - 2005 Pieter Pareit 
| 
| ;; 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 2 of
| ;; the License, or (at your option) any later version.
| [...]
| ;; Authors: Pieter Pareit 
| ;;          Rubens Ramos 
| ;; Maintainer: Pieter Pareit 
`----


Author/copyright info for highlight-beyond-fill-column.el:
,----
| ;;; highlight-beyond-fill-column.el --- font-lock-add-keywords aid for Emacs
|
| ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
|
| ;; Author: Sandip Chitale (sandip.chitale@blazesoft.com)
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for highlight-completion.el:
,----
| ;;; highlight-completion.el --- completion with highlighted provisional text
| ;; Copyright (c) 1991-1996 Mark Haiman, Nick Reingold, John Palmieri
| ;; Copyright (c) 1997-2001 John Palmieri
| ;;
| ;; Author: John Palmieri 
| [...]
| ;; This package 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for highlight-current-line.el:
,----
| ;; Copyright (c) 1997 Christoph Conrad
|
| ;; Author: Christoph Conrad 
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for home-end.el:
,----
| ;;; home-end.el --- Alternative Home and End commands.
| ;; Copyright 1996 Kai Grossjohann and Toby Speight
| ;; Copyright 2002 Toby Speight
| 
| ;; home-end.el is free software distributed under the terms of the GNU
| ;; General Public Licence, version 3.
`----


Author/copyright info for htmlize.el:
,----
| ;; Copyright (C) 1997,1998,1999,2000 Hrvoje Niksic
|
| ;; Author: Hrvoje Niksic 
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for initsplit.el:
,----
| ;;; initsplit --- code to split customizations into different files
|
| ;; Copyright (C) 2000, 2001 John Wiegley
|
| ;; Author: John Wiegley 
| [...]
| ;; 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 2, or (at
| ;; your option) any later version.
`----


Author/copyright info for joc-toggle-buffer.el (eenamed from toggle-buffer.el)
,----
| ;;; @(#) toggle-buffer.el --- flips back and forth between two buffers
| [...]
| ;; Copyright (C) 2001 by Joseph L. Casadonte Jr.
|
| ;; Author:          Joe Casadonte (emacs@northbound-train.com)
| ;; Maintainer:      Joe Casadonte (emacs@northbound-train.com)
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for joc-toggle-case.el (renamed from toggle-case.el):
,----
| ;;; **************************************************************************
| ;; @(#) toggle-case.el -- toggles case at poitn like ~ in vi
| [...]
| ;; Copyright (C) 2001 by Joseph L. Casadonte Jr.
| ;; Author:          Joe Casadonte (emacs@northbound-train.com)
| ;; Maintainer:      Joe Casadonte (emacs@northbound-train.com)
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for keydef.el:
,----
| ;;; keydef.el --- a simpler way to define keys, with kbd syntax
|
| ;; Emacs Lisp Archive Entry
| ;; Filename: keydef.el
| ;; Author: Michael John Downes 
| [...]
| ;; This program was placed in the public domain on 2001/01/18 by the
| ;; Author. The 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.
`----


Author/copyright info for keywiz.el:
,----
| ;;; keywiz.el --- Emacs key sequence quiz
|
| ;; Copyright (C) 2002 Jesper Harder
|
| ;; Author: Jesper Harder 
| [...]
| ;; 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 2 of
| ;; the License, or (at your option) any later version.
`----


Author/copyright info for lcomp.el
,----
| ;;; lcomp.el --- list-completion hacks!
| 
| ;; Copyright (C) 2002 by Taiki SUGAWARA 
| 
| ;; Author: Taiki SUGAWARA 
| 
| ;; This file 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for maplev.el and maplev.texi
,----
| ;;; maplev.el --- Maple mode for GNU Emacs
| ;; Copyright (C) 2001,2003 Joseph S. Riel
| 
| ;; Authors:    Joseph S. Riel 
| ;;             and Roland Winkler 
| ;; X-URL:      http://www.k-online.com/~joer/maplev/maplev.html
| 
| ;; 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 2 of the
| ;; License, or (at your option) any later version.
`----


Author/copyright info for map-lines.el:
,----
| ;; Copyright (C) 2002  Andreas Fuchs 
|
| ;; Author: Andreas Fuchs 
| [...]
| ;; This file 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for matlab.el
,----
| ;; Copyright (C) 1997-1999 Eric M. Ludlam
| ;; Copyright (C) 1991-1997 Matthew R. Wette
| ;;
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for markdown-mode.el:
,----
| ;; Author: Jason Blevins 
| ;; Created: May 24, 2007
| ;; $Id: emacs-goodies-el.copyright,v 1.37 2011-08-16 16:12:50 psg Exp $
| ;; Keywords: Markdown major mode
| ;;
| ;; Copyright (C) 2007 Jason Blevins
| ;;
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for marker-visit.el:
,----
| ;;; marker-visit.el --- navigate through a buffer's marks in order
| 
| ;; Copyright (C) 2001 Benjamin Rutt
| 
| ;; This file 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 2, or (at your
| ;; option) any later version.
`----


Author/copyright info for minibuf-electric.el
,----
| ;; Extracted from minibuf.el --- Minibuffer functions for XEmacs
| ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
| ;; Copyright (C) 1995 Tinker Systems.
| ;; Copyright (C) 1995, 1996, 2000 Ben Wing.
| 
| ;; Modified by Karl Hegbloom for GNU Emacs.
| ;; GPL
`----


Author/copyright info for minibuffer-complete-cycle.el
,----
| ;; Copyright © 1997,1998,2000,2003 Kevin Rodgers
|
| ;; Author: Kevin Rodgers 
| [...]
| ;; 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 2 of
| ;; the License, or (at your option) any later version.
`----

Author/copyright info for miniedit.el
,----
| ;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
| ;; Author(s): Deepak Goel ,
| ;;            Christoph Conrad < christoph.conrad@gmx.de>
| 
| ;; This 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for mutt-alias.el:
,----
| ;;; mutt-alias.el --- Lookup/insert mutt mail aliases.
| ;; Copyright 1999,2000 by Dave Pearson 
| [...]
| ;; mutt-alias is free software distributed under the terms of the GNU
| ;; General Public Licence, version 2. For details see the file COPYING.
`----


Author/copyright info for muttrc-mode.el:
,----
| ;;; muttrc-mode.el --- Major mode to edit muttrc under Emacs
|
| ;;; Copyright (C) 2000, 2001, 2002 Laurent Pelecq
| ;;;
| ;;; Author: Laurent Pelecq 
|
| ;;; 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 2, or (at your option)
| ;;; any later version.
`----


Author/copyright info for obfusurl.el:
,----
| ;; Copyright 2001-2008 by Dave Pearson 
| ;; $Revision: 1.37 $
| 
| ;; obfusurl.el is free software distributed under the terms of the GNU
| ;; General Public Licence, version 2 or (at your option) any later version.
`----


Author/copyright info for pack-windows.el
,----
| ;;; pack-windows.el --- Resize all windows to display as much info as possible.
| 
| ;; Copyright (C) 2000 Michel Schinz
|           
| ;; 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 2 of
| ;; the License, or (at your option) any later version.
`----


Author/copyright info for perldoc.el:
,----
| ;;; perldoc.el --- Show help for Perl functions, builtins, and modules.
|
| ;;
| ;; Copyright (C) 2000-2002 Steve Kemp 
| ;; Copyright (C) 2003, 2005 Peter S Galbraith 
| ;; Copyright (C) 2008-2009 Ben Voui 
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for pp-c-l.el:
,----
| ;; Filename: pp-c-l.el
| ;; Description: Display Control-l characters in a buffer in a pretty way
| ;; Author: Drew Adams
| ;; Maintainer: Drew Adams
| ;; Copyright (C) 2007-2010, Drew Adams, all rights reserved.
| [...]
| ;; URL: http://www.emacswiki.org/cgi-bin/wiki/pp-c-l.el
| [...]
| ;; 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 2, or
| ;; (at your option) any later version.
`----


Author/copyright info for pod-mode.el:
,----
| ;;; pod-mode.el --- Major mode for editing .pod-files
|
| ;;; Copyright 2003-2005 Steffen Schwigon
|
| ;;; Author: Steffen Schwigon 
| ;;; Version: 0.4
| ;;; CVS Version: $Id: emacs-goodies-el.copyright,v 1.37 2011-08-16 16:12:50 psg Exp $
| ;;; Keywords: perl pod
| ;;; X-URL: http://search.cpan.org/~schwigon/pod-mode/
|
| ;;; 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 2, or (at your option)
| ;;; any later version.
`----


Author/copyright info for projects.el:
,----
| ;;; projects.el -- Project-based buffer name management
|
| ;; Copyright 1998 Naggum Software
|
| ;; Author: Erik Naggum 
| ;; Keywords: internal
|
| ;; This file is not part of GNU Emacs, but distributed under the same
| ;; conditions as GNU Emacs, and is useless without 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for protbuf.el:
,----
| ;;; protbuf.el --- protect buffers from accidental killing
|
| ;; Copyright (C) 1994, 1999 Noah S. Friedman
|
| ;; Author: Noah Friedman 
| ;; Maintainer: friedman@splode.com
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for protocols.el:
,----
| ;;; protocols.el --- Protocol database access functions.
| ;; Copyright 2000-2008 by Dave Pearson 
| ;; $Revision: 1.37 $
| 
| ;; protocols.el is free software distributed under the terms of the GNU
| ;; General Public Licence, version 2 or (at your option) any later version.
| ;; For details see the file COPYING.
`----

Author/copyright info for quack.el:

,----
| ;;; quack.el --- Enhanced support for editing and running Scheme code
| ;; Copyright 2002-2009 by Neil Van Dyke 
| [...]
| ;; This 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 2, or (at your option) any later version.
`----

Author/copyright info for rfcview.el:
,----
| ;;; rfcview.el -- view IETF RFCs with readability-improved formatting
| 
| ;; Copyright (C) 2001-2002 Neil W. Van Dyke
| 
| ;; Author:   Neil W. Van Dyke 
| 
| ;; This 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 2, or (at your option) any later version.
`----


Author/copyright info for services.el:
,----
| ;;; services.el --- Services database access functions.
| ;; Copyright 2000-2008 by Dave Pearson 
| ;; $Revision: 1.37 $
| 
| ;; services.el is free software distributed under the terms of the GNU
| ;; General Public Licence, version 2 or (at your option) any later version.
`----


Author/copyright info for session.el
,----
| ;;; session.el --- use variables, registers and buffer places across sessions
|
| ;; Copyright 1996-1999, 2001-2003 Free Software Foundation, Inc.
| ;;
| ;; Author: Christoph Wedler 
| ;; X-URL: http://emacs-session.sourceforge.net/
|
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for setnu.el:
,----
| ;;; vi-style line number mode for Emacs
| ;;; (requires Emacs 19.29 or later, or XEmacs 19.14 or later)
| ;;; Copyright (C) 1994, 1995, 1997 Kyle E. Jones
| ;;;
| ;;; 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 2, or (at your option)
| ;;; any later version.
`----


Author/copyright info for shell-command.el:
,----
| ;;; shell-command.el --- enabling (tab)completion for shell-command
| 
| ;; Copyright (C) 1998-2003 TSUCHIYA Masatoshi 
| 
| ;; Author: TSUCHIYA Masatoshi 
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for show-wspace.el:
,----
| ;;; show-wspace.el --- Highlight whitespace of various kinds.
|
| ;; Author: Peter Steiner , Drew Adams
| ;; Maintainer: Drew Adams
| ;; Copyright (C) 2000-2007, Drew Adams, all rights reserved.
| ;; [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`---


Author/copyright info for silly-mail.el:
,----
| ;;; silly-mail.el --- generate bozotic mail headers
|
| ;; Compilation Copyright (C) 1993, 94, 95, 96, 97, 98, 99, 2000 Noah S. Friedman
|
| ;; Contributors: Noah Friedman, Jamie Zawinski, Jim Blandy,
| ;;               Thomas Bushnell, Roland McGrath,
| ;;               and a cast of dozens.
| ;; Maintainer: Noah Friedman 
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for slang-mode.el
 http://home.mchsi.com/~jmrobert5/files/slang-mode.el
,----
| ;;; slang-mode.el --- a major-mode for editing slang scripts
| 
| ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
| 
| ;; Modified By: Joe Robertson 
| ;; Modified From: tcl-mode.el
| ;; 
| ;; Original Author: Gregor Schmid 
| ;; Keywords: languages, processes, tools
| 
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for tabbar.el:
,----
| ;;; tabbar.el --- Display a tab bar in the header line
| 
| ;; Copyright (C) 2003 David Ponce
| 
| ;; Author: David Ponce 
| ;; Maintainer: David Ponce 
| [...]
| ;; This file is not part of GNU Emacs.
| 
| ;; 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 2, or (at
| ;; your option) any later version.
`----


Author/copyright info for tail.el:
,----
| ;;; tail.el --- Tail files within Emacs
|
| ;; Copyright (C) 2000 by Benjamin Drieu
|
| ;; Author: Benjamin Drieu 
| [...]
| ;; This program as GNU Emacs are free software; you can redistribute
| ;; them and/or modify them under the terms of the GNU General Public
| ;; License as published by the Free Software Foundation; either
| ;; version 2, or (at your option) any later version.
`----


Author/copyright info for tc.el:
,----
| ;; trivial-cite -- cite text with proper filling
| [...]
| ;; This program is copyright (c) 1998 Lars R. Clausen
| [...]
| ;; Author: Lars R. Clausen 
| [...]
| ;; trivial-cite 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for tlc.el
,----
| ;; Copyright (c) 1997, 1998 by The MathWorks, Inc.
| ;;
| ;; This program is derived from 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 2, or
| ;; (at your option) any later version.
`----


Author/copyright info for thinks.el:
,----
| ;;; thinks.el --- Insert text in a think bubble.
| ;; Copyright 2000-2008 by Dave Pearson 
| ;; $Revision: 1.37 $
| 
| ;; thinks.el is free software distributed under the terms of the GNU General
| ;; Public Licence, version 2 or (at your option) any later version. For
| ;; details see the file COPYING.
`----


Author/copyright info for tld.el:
,----
| ;;; tld.el --- TLD lookup tool.
| ;; Copyright 2000-2008 by Dave Pearson 
| ;; $Revision: 1.37 $
| 
| ;; tld.el is free software distributed under the terms of the GNU General
| ;; Public Licence, version 2 or (at your option) any later version. For
| ;; details see the file COPYING.
`----


Author/copyright info for todoo.el:
,----
| ;; todoo.el -- Major mode for editing TODO files
|
| ;; Copyright (C) 1999 Daniel Lundin 
| [...]
| ;; This 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for toggle-option.el:
,----
| ;;; toggle-option.el --- easily toggle frequently toggled options
|
| ;; Copyright (C) 2001 Cyprian Laskowski
|
| ;; Author: Cyprian Laskowski 
| [...]
| ;; 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 2, or (at
| ;; your option) any later version.
`----


Author/copyright info for twiddle.el:
,----
| ;;; twiddle.el --- mode-line display hack
|
| ;; Copyright (C) 1997 Noah S. Friedman
|
| ;; Author: Noah Friedman 
| ;; Maintainer: friedman@prep.ai.mit.edu
| [...]
| ;; 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for under.el:
,----
| ;; Copyright (C) 1998 by Benjamin Drieu
| ;; Author:	 Benjamin Drieu 
| ;; Maintainer:	 Benjamin Drieu 
| [...]
| ;; 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 2, or (at
| ;; your option) any later version.
`----

Author/copyright info for upstart-mode.el:
,----
| ;;; upstart-mode.el --- Syntax highlighting for upstart
| ;;;
| ;;; Copyright © 2010 Stig Sandbeck Mathisen 
| 
| ;;; 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 2 of the
| ;;; License, or (at your option) any later version.
`----

Author/copyright info for xrdb-mode.el:
,----
| ;;; xrdb-mode.el --- mode for editing X resource database files
|
| ;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
|
| ;; Author:        1994-2002 Barry A. Warsaw
| ;; Maintainer:    barry@python.org
| [...]
| ;; 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 2
| ;; of the License, or (at your option) any later version.
`----
emacs-goodies-el-35.8ubuntu2/debian/vm-bonus-el.emacsen-startup0000775000000000000000000000252412230377266021444 0ustar  ;; -*-emacs-lisp-*-
;;
;; Emacs startup file for the Debian GNU/Linux vm-bonus-el package

(cond
 ((not (file-exists-p "/usr/share/emacs/site-lisp/vm-bonus-el"))
  (message "Package vm-bonus-el removed but not purged.  Skipping setup."))
 ((not (file-exists-p (concat "/usr/share/"
                              (symbol-name debian-emacs-flavor)
                              "/site-lisp/vm-bonus-el/vm-bogofilter.elc")))
  (message "Package vm-bonus-el not fully installed.  Skipping setup."))
 (t
  (debian-pkg-add-load-path-item
   (concat "/usr/share/"
           (symbol-name debian-emacs-flavor)
           "/site-lisp/vm-bonus-el"))

  (defgroup vm-bonus-el nil
    "Customize vm-bonus-el Debian packages."
    :group 'vm)

  ;; vm-bogofilter.el
  (defgroup vm-bogofilter nil
    "VM Spam Filter Options"
    :group 'vm
    :group 'vm-bonus-el
    :load 'vm-bogofilter)

  (autoload 'vm-bogofilter-setup "vm-bogofilter"
    "Initialize vm-bogofilter."
    t)

  (defcustom vm-bogofilter-setup nil
    "Whether to initialize vm-bogofilter on startup.
vm-bogofilter interfaces VM with the bogofilter spam filter."
    :type 'boolean
    :set (lambda (symbol value)
           (set-default symbol value)
           (when value
             (vm-bogofilter-setup)))
    :load 'vm-bogofilter
    :group 'vm
    :group 'vm-bogofilter
    :group 'vm-bonus-el)
  ))
emacs-goodies-el-35.8ubuntu2/debian/gnus-bonus-el.install0000775000000000000000000000137012230377266020327 0ustar  elisp/gnus-bonus-el/gnus-eyecandy.el /usr/share/emacs/site-lisp/gnus-bonus-el/
elisp/gnus-bonus-el/gnus-filterhist.el /usr/share/emacs/site-lisp/gnus-bonus-el/
elisp/gnus-bonus-el/gnus-junk.el /usr/share/emacs/site-lisp/gnus-bonus-el/
elisp/gnus-bonus-el/gnus-outlook-deuglify.el /usr/share/emacs/site-lisp/gnus-bonus-el/
elisp/gnus-bonus-el/gnus-pers.el /usr/share/emacs/site-lisp/gnus-bonus-el/
elisp/gnus-bonus-el/message-x.el /usr/share/emacs/site-lisp/gnus-bonus-el/
elisp/gnus-bonus-el/nnir.el /usr/share/emacs/site-lisp/gnus-bonus-el/
elisp/gnus-bonus-el/nnnil.el /usr/share/emacs/site-lisp/gnus-bonus-el/
elisp/gnus-bonus-el/nntodo.el /usr/share/emacs/site-lisp/gnus-bonus-el/
elisp/gnus-bonus-el/spam-stat.el /usr/share/emacs/site-lisp/gnus-bonus-el/
emacs-goodies-el-35.8ubuntu2/debian/devscripts-el.emacsen-startup0000775000000000000000000000400512230377266022060 0ustar  ;; -*-emacs-lisp-*-
;;
;; Emacs startup file for the Debian GNU/Linux devscripts-el package

(cond
 ((not (file-exists-p "/usr/share/emacs/site-lisp/devscripts-el"))
  (message "Package devscripts-el removed but not purged.  Skipping setup."))
 ((not (file-exists-p (concat "/usr/share/"
                              (symbol-name debian-emacs-flavor)
                              "/site-lisp/devscripts-el/pbuilder-mode.elc")))
  (message "Package devscripts-el not fully installed.  Skipping setup."))
 (t

  (debian-pkg-add-load-path-item
   (concat "/usr/share/"
           (symbol-name debian-emacs-flavor)
           "/site-lisp/devscripts-el"))
  
  ;; autoloads for devscripts.el
  (autoload 'debuild "devscripts" "Run debuild in the current directory." t)
  (autoload 'debc "devscripts" "Run debc in the current directory." t)
  (autoload 'debi "devscripts" "Run debi in the current directory." t)
  (autoload 'debit "devscripts" "Run debit in the current directory." t)
  (autoload 'debdiff "devscripts" "Compare contents of CHANGES-FILE-1 and CHANGES-FILE-2." t)
  (autoload 'debdiff-current "devscripts"   "Compare the contents of .changes file of current version with previous version; 
requires access to debian/changelog, and being in debian/ dir." t)
  (autoload 'debclean "devscripts" "Run debclean in the current directory." t)
  (autoload 'pdebuild "pbuilder-mode" "Run pdebuild in the current directory." t)
  (autoload 'pdebuild-user-mode-linux "pbuilder-mode" "Run pdebuild-user-mode-linux in the current directory." t)
  (autoload 'pbuilder-log-view-elserv "pbuilder-log-view-mode" "Run a elserv session with log view.

Running this requires elserv.  Use elserv, and do `elserv-start' before invoking this command." t)
  (autoload 'debuild-pbuilder "pbuilder-mode" "Run debuild-pbuilder in the current directory." t)
  (autoload 'pbuilder-build "pbuilder-mode" "Run pbuilder-build for the given filename." t)
  (autoload 'pbuilder-user-mode-linux-build "pbuilder-mode" "Run pbuilder-user-mode-linux for the given filename." t)))
emacs-goodies-el-35.8ubuntu2/debian/debian-el.copyright0000775000000000000000000000667712230377266020032 0ustar  This package was first debianized by Roland Mas 
It is currently maintained by Peter S Galbraith 

  This collection of files was assembled by Roland Mas 
from various messages posted on the gnu.emacs.sources newsgroup, as well as
from various collections of Emacs Lisp files found on the web.  Some
authors contacted Roland directly, some users sent me the files by email.
Most of them are covered by the GNU GPL, but the individual licences can
vary.  Here is a list of excerpts of the included files covering this
matter.

  The text of the GNU GPL can be found in /usr/share/common-licenses.

Copyright info for files in debian-el
-------------------------------------

Author/copyright info for apt-sources.el:
,----
| ;;; apt-sources.el --- Mode for editing apt source.list file
| [...]
| ;; Author: Dr. Rafael Sepúlveda. 
| ;; Mantainer: Dr. Rafael Sepúlveda. 
| 
| ;; Copyright (C) 2001-2002, Dr. Rafael Sepúlveda 
| 
| ;;   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.
`----


Author/copyright info for apt-utils.el:
,-
| ;;; Copyright (C) 2002, 03 Matthew P. Hodges
| 
| ;; apt-utils.el 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 2, or (at
| ;; your option) any later version.
| 
| ;; apt-utils.el 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.
`-


Author/copyright info for debian-bug.el:
,----
| ;; Copyright (C) 1998, 1999 Free Software Foundation, Inc.
| ;; Copyright (C) 2001, 2002 Peter S Galbraith 
| 
| ;; Author (Up to version 1.7):           Francesco Potortì 
| ;; Maintainer from version 1.8 onwards:  Peter S Galbraith 
| ;; Keywords: debian, bug, reporter
| 
| ;; debian-bug.el 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for deb-view.el
,----
| ;; Author:  Rick Macdonald (rickm@vsl.com)
| 
| ;; deb-view 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for gnus-BTS.el:
,----
| ;; Copyright (C) 2001 Andreas Fuchs 
| [...]
| ;; gnus-BTS.el 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for preseed.el
,----
| ;; Copyright (C) 2004 W. Borgert 
| 
| ;; This package 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 2, or (at your option)
| ;; any later version.
`----
emacs-goodies-el-35.8ubuntu2/debian/debview.copyright0000775000000000000000000000037312230377266017622 0ustar  The content of the package debview has been moved to the package debian-el.

This package ensures that debian-el is installed during upgrades and
should thereafter be removed.

The contents are in the public domain.
Peter S Galbraith 
emacs-goodies-el-35.8ubuntu2/debian/emacs-goodies-el.emacsen-install.in0000775000000000000000000000207712230377266022771 0ustar  #! /bin/bash -e
# /usr/lib/emacsen-common/packages/install/emacs-goodies-el

# Written by Jim Van Zandt , borrowing heavily
# from the install scripts for gettext by Santiago Vila
#  and octave by Dirk Eddelbuettel .
#
# Patched by Roland Mas  to add support for lists
# of flavor-dependently included/excluded files

FLAVOR=$1
STAMPFILE=emacs-goodies-el.elc
PACKAGE=emacs-goodies-el

# INCLUDED_emacs20=""
# INCLUDED_emacs21=""
# INCLUDED_xemacs21=""

EXCLUDED_emacs20="tabbar.el session.el csv-mode.el maplev.el"
EXCLUDED_emacs21="pod-mode.el"
EXCLUDED_xemacs21="csv-mode.el minibuf-electric.el pp-c-l.el tabbar.el todoo.el rfcview.el upstart-mode.el "
#EXCLUDED_emacs_snapshot="cua.el cfengine.el ibuffer.el ido.el newsticker.el table.el "
#EXCLUDED_emacs22="cua.el cfengine.el ibuffer.el ido.el newsticker.el table.el "
#EXCLUDED_emacs23="cua.el cfengine.el ibuffer.el ido.el newsticker.el table.el  "

# Skip byte-compilation here if necessary:
#SOURCEONLY_all="emacs-goodies-el.el emacs-goodies-loaddefs.el"
emacs-goodies-el-35.8ubuntu2/debian/emacs-goodies-el.emacsen-startup0000775000000000000000000000130112230377266022405 0ustar  ;; -*-emacs-lisp-*-
;;
;; Emacs startup file for the Debian GNU/Linux emacs-goodies-el package

(cond
 ((not (file-exists-p "/usr/share/emacs/site-lisp/emacs-goodies-el"))
  (message
   "Package emacs-goodies-el removed but not purged.  Skipping setup."))
 ((not (file-exists-p (concat "/usr/share/"
                              (symbol-name debian-emacs-flavor)
                              "/site-lisp/emacs-goodies-el/xrdb-mode.elc")))
  (message "Package emacs-goodies-el not fully installed.  Skipping setup."))
 (t 
  (debian-pkg-add-load-path-item
   (concat "/usr/share/"
           (symbol-name debian-emacs-flavor)
           "/site-lisp/emacs-goodies-el"))
  
  (require 'emacs-goodies-el)))
emacs-goodies-el-35.8ubuntu2/debian/README.source0000775000000000000000000000045512230377266016423 0ustar  This package uses quilt to manage all modifications. See

  /usr/share/doc/quilt/quilt.pdf.gz

to get more information on how to use it.

To apply and unppaly all patches, you can run:

 debian/rules patch
 debian/rules unpatch

 -- Peter S Galbraith , Mon,  5 Apr 2010 16:30:13 -0400
emacs-goodies-el-35.8ubuntu2/debian/gnus-bonus-el.copyright0000775000000000000000000001256312230377266020677 0ustar  This package was first debianized by Roland Mas 
It is currently maintained by Peter S Galbraith 

  This collection of files was assembled by Roland Mas 
from various messages posted on the gnu.emacs.sources newsgroup, as well as
from various collections of Emacs Lisp files found on the web.  Some
authors contacted Roland directly, some users sent me the files by email.
Most of them are covered by the GNU GPL, but the individual licences can
vary.  Here is a list of excerpts of the included files covering this
matter.

  The text of the GNU GPL can be found in /usr/share/common-licenses.


Copyright info for files in gnus-bonus-el
-----------------------------------------

Author/copyright info for gnus-eyecandy.el:
,----
| ;;; gnus-eyecandy.el --- add some eyecandy to Gnus
| 
| ;; Copyright (C) 1999 BrYan P. Johnson
| 
| ;; Modified 2003-10-15 to work with GNU Emacs
| ;; by Johan Bockgård 
| [...]
| ;; gnus-eyecandy.el 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 2, or (at your option) any later
| ;; version.
`----


Author/copyright info for gnus-filterhist.el:
,----
| ;;; gnus-filterhist.el --- Gnus Filter Histories -- parse nnmail-split-history to provide reports of mail splits.
| 
| ;; Copyright (C) 1999 BrYan P. Johnson
| [...]
| ;; gnus-filterhist.el 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 2, or (at your option) any later
| ;; version.
`----


Author/copyright info for gnus-junk.el:
,----
| ;;; gnus-junk.el --- a response to junk e-mails
| 
| ;; Copyright (C) 1996,1997 Robert Bihlmeyer
| 
| ;; Author: Robert Bihlmeyer 
| [...]
| ;; 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 2, or (at your option) any later
| ;; version.
`----


Author/copyright info for gnus-outlook-deuglify.el:
,----
| ;;; gnus-outlook-deuglify.el --- deuglify broken Outlook (Express) articles
| 
| ;; Copyright (C) 2001,2002 Raymond Scholz
| 
| ;; Author: Raymond Scholz 
| ;;         Thomas Steffen (unwrapping algorithm,
| ;;                         based on an idea of Stefan Monnier)
| [...]
| ;; This file 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for gnus-pers.el:
,----
| ;;; gnus-pers.el --- an alternative to gnus-posting-styles
| 
| ;; Copyright (C) 1999 BrYan P. Johnson
| 
| ;; Author: BrYan P. Johnson 
| [...]
| ;; gnus-pers.el 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 2, or (at your option) any later
| ;; version.
`----


Author/copyright info for message-x.el:
,----
| ;; message-x.el -- customizable completion in message headers
| ;; Copyright (C) 1998 Kai Großjohann
| [...]
| ;; Author: Kai Grossjohann 
| ;; Keywords: news, mail, compose, completion
| [...]
| ;; This 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for nnnil.el:
,----
| ;;; nnnil.el: empty, read-only backend for Gnus              -*- emacs-lisp -*-
| ;;; 
| ;;; Written and placed in the public domain by Paul Jarc .  
`----


Author/copyright info for nnir.el:
,----
| ;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*-
| ;; Copyright (C) 1998 Kai Großjohann
| [...]
| ;; Author: Kai Großjohann 
| [...]
| ;; This 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for nntodo.el:
,----
| ;;; nntodo.el --- Manage todo items with Gnus
| 
| ;; Copyright (C) 1999 by Kai Grossjohann.
| 
| ;; Authors: Kai.Grossjohann@CS.Uni-Dortmund.DE,
| ;;          John Wiegley 
| [...]
| ;; This file 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 2, or (at your option)
| ;; any later version.
`----


Author/copyright info for spam-stat.el:
,----
| ;;; spam-stat.el --- detecting spam based on statistics
| 
| ;; Copyright (C) 2002  Alex Schroeder 
| 
| ;; Author: Alex Schroeder 
| [...]
| ;; This 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 2, or (at your option)
| ;; any later version.
`----
emacs-goodies-el-35.8ubuntu2/debian/dpkg-dev-el.emacsen-remove.in0000775000000000000000000000014212230377266021571 0ustar  #!/bin/sh -e
# /usr/lib/emacsen-common/packages/remove/dpkg-dev-el

FLAVOR=$1
PACKAGE=dpkg-dev-el
emacs-goodies-el-35.8ubuntu2/debian/source/0000775000000000000000000000000012230377267015536 5ustar  emacs-goodies-el-35.8ubuntu2/debian/source/format0000775000000000000000000000001512230377267016750 0ustar  3.0 (native)
emacs-goodies-el-35.8ubuntu2/debian/devscripts-el.install0000775000000000000000000000036312230377266020416 0ustar  elisp/devscripts-el/devscripts.el /usr/share/emacs/site-lisp/devscripts-el/
elisp/devscripts-el/pbuilder-log-view-mode.el /usr/share/emacs/site-lisp/devscripts-el/
elisp/devscripts-el/pbuilder-mode.el /usr/share/emacs/site-lisp/devscripts-el/
emacs-goodies-el-35.8ubuntu2/debian/devscripts-el.copyright0000775000000000000000000000144212230377266020757 0ustar  This package was first debianized by Roland Mas 
The source package `emacs-goodies-el' is maintained by Peter S Galbraith
.
The binary package `devscripts-el' is maintained by its upstream author
Junichi Uekawa .


Copyright info for files in devscripts-el
-----------------------------------------

Author/copyright info for devscripts.el, pbuilder-log-view-mode.el and
pbuilder-mode.el

,----
| ;; copyright 2002 Junichi Uekawa.
| [...]
| This file 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 2, or (at your option)
| any later version.
`----

The text of the GNU GPL can be found in /usr/share/common-licenses.
emacs-goodies-el-35.8ubuntu2/debian/dpkg-dev-el.emacsen-install.in0000775000000000000000000000121512230377266021744 0ustar  #! /bin/bash -e
# /usr/lib/emacsen-common/packages/install/dpkg-dev-el

# Written by Jim Van Zandt , borrowing heavily
# from the install scripts for gettext by Santiago Vila
#  and octave by Dirk Eddelbuettel .
#
# Patched by Roland Mas  to add support for lists
# of flavor-dependently included/excluded files

FLAVOR=$1
STAMPFILE=debian-changelog-mode.elc
PACKAGE=dpkg-dev-el

APPEND_LOAD_PATH="'(\"/usr/share/emacs/site-lisp/debian-el/\")"

# INCLUDED_emacs20=""
# INCLUDED_emacs21=""
# INCLUDED_xemacs21=""

# EXCLUDED_emacs20=""
# EXCLUDED_emacs21=""
# EXCLUDED_xemacs21=""
emacs-goodies-el-35.8ubuntu2/debian/gnus-bonus-el.README.Debian0000775000000000000000000000525312230377266021003 0ustar    This is an introductory starter for the various goodies included in
gnus-bonus-el.  It does not intend to replace reading the documentation
that is made available in the files themselves (or not available at all,
except insofar as code is self-documenting).

You may customize files in this package by using:

 M-x customize-group [RET] gnus-bonus-el [RET]

Introduction to files in gnus-bonus-el
--------------------------------------

gnus-eyecandy.el allows you to gratuitously add icons to your group
buffer in a manner similar to the way that you currently specify group
highlighting, ie a Form/File alist rather than a Form/Face alist.

gnus-filterhist.el creates a buffer with a summary of the number of
messages you've received per mailbox. This summary is cleared every
time you check mail.

gnus-junk.el provides a semi-automated way to deal with unsolicited
commercial e-mail (also known as "spam").  It provides the M-x
gnus-junk-complain command (use it in your *Summary* buffer).

gnus-outlook-deuglify.el removes some of the ugliness introduced by
Outlook (and maybe other agents too) users in the quoting that appears
in their answers.  To use: add (require 'gnus-outlook-deuglify) to
your Gnus and you're enabled to press `W k' in the Summary Buffer.

gnus-pers.el is an alternative to gnus-postins-styles. It implements
personalities for Message mode. It allows you to define a personality
with any e-mail address, extra headers and signature you like, either
as strings, functions or variables (signatures may also be
files). Then it will chose a personality for you based on header info,
gnus-newsgroup-name or group parameter. Additionally, you can change a
personality in the middle of writing a message.

message-x.el provides customizable completion in message headers.  Add
(require 'message-x) to your .gnus.

nnir.el provides the nnir backend, to search mail with various search
engines.  Add (require 'nnir) to your .gnus.

nnnil.el provides an empty, read-only backend for Gnus.  This backend
is suitable for use as the primary server when real servers are to be
secondary or foreign.  Add (require 'nnnil) to your .gnus.

nntodo.el provides a backend to manage todo items with Gnus.  Each
todo item is a message.  Add (require 'nntodo) to your .gnus.

spam-stat.el performs spam detection based on statistics.  To use, add
(require 'spam-stat) and (spam-stat-load) to your .gnus file, use the
spam-stat-buffer-is-spam and spam-stat-buffer-is-non-spam functions
(or spam-stat-buffer-change-to-spam and
spam-stat-buffer-change-to-non-spam) in the appropriate buffers, and
add the rule (: gnus-spam-stat-split) to `nnmail-split-fancy'.

 -- Peter S Galbraith , Mon Oct 24 21:07:13 2005
emacs-goodies-el-35.8ubuntu2/debian/debian-el.emacsen-remove.in0000775000000000000000000000013612230377266021315 0ustar  #!/bin/sh -e
# /usr/lib/emacsen-common/packages/remove/debian-el

FLAVOR=$1
PACKAGE=debian-el
emacs-goodies-el-35.8ubuntu2/debian/vm-bonus-el.emacsen-remove.in0000775000000000000000000000014212230377266021636 0ustar  #!/bin/sh -e
# /usr/lib/emacsen-common/packages/remove/vm-bonus-el

FLAVOR=$1
PACKAGE=vm-bonus-el
emacs-goodies-el-35.8ubuntu2/debian/emacsen-remove.template0000775000000000000000000000057212230377266020707 0ustar  
if [ ${FLAVOR} != emacs ]; then
    if test -x /usr/sbin/install-info-altdir; then
        echo remove/${PACKAGE}: removing Info links for ${FLAVOR}
        install-info-altdir --quiet --remove --dirname=${FLAVOR} /usr/info/${PACKAGE}.info.gz
    fi

    echo remove/${PACKAGE}: purging byte-compiled files for ${FLAVOR}
    rm -rf /usr/share/${FLAVOR}/site-lisp/${PACKAGE}
fi
emacs-goodies-el-35.8ubuntu2/debian/gnus-bonus-el.emacsen-startup0000775000000000000000000000306212230377266021774 0ustar  ;; -*-emacs-lisp-*-
;;
;; Emacs startup file for the Debian GNU/Linux gnus-bonus-el package

;; The gnus-bonus-el package follows the Debian/GNU Linux 'emacsen' policy and
;; byte-compiles its elisp files for each 'emacs flavor' (emacs19,
;; xemacs19, emacs20, xemacs20...).  The compiled code is then
;; installed in a subdirectory of the respective site-lisp directory.

(cond
 ((not (file-exists-p "/usr/share/emacs/site-lisp/gnus-bonus-el"))
  (message "Package gnus-bonus-el removed but not purged.  Skipping setup."))
 ((not (file-exists-p (concat "/usr/share/"
                              (symbol-name debian-emacs-flavor)
                              "/site-lisp/gnus-bonus-el/nntodo.elc")))
  (message "Package gnus-bonus-el not fully installed.  Skipping setup."))
 (t
  (debian-pkg-add-load-path-item
   (concat "/usr/share/"
           (symbol-name debian-emacs-flavor)
           "/site-lisp/gnus-bonus-el"))

  ;; autoloads for gnus-junk.el
  (autoload 'gnus-junk-complain "gnus-junk"
    "Mail a complaint about next messages to (hopefully) relevant people."
    t)

  ;; autoloads for gnus-pers.el
  (autoload 'gnus-personality-init "gnus-pers"
    "Install Personality functionality into message mode."
    t)

  ;; autoloads for gnus-eyecandy.el
  (autoload 'gnus-group-line-add-icon "gnus-eyecandy"
    "Highlight the current line according to `gnus-group-icon-list'."
    nil)

  ;; autoloads for gnus-filterhist.el
  (autoload 'gnus-filter-history "gnus-filterhist"
    "Create a buffer *Filter History* with the results of the latest nnmail split."
    t)
  ))
emacs-goodies-el-35.8ubuntu2/debian/vm-bonus-el.emacsen-install.in0000775000000000000000000000115612230377266022015 0ustar  #! /bin/bash -e
# /usr/lib/emacsen-common/packages/install/vm-bonus-el

# Written by Jim Van Zandt , borrowing heavily
# from the install scripts for gettext by Santiago Vila
#  and octave by Dirk Eddelbuettel .

FLAVOR=$1
PACKAGE=vm-bonus-el
STAMPFILE=vm-bogofilter.elc
# No longer use this append, rather use proper site-init
# See bug #706746
# APPEND_LOAD_PATH="'(\"/usr/share/emacs/site-lisp/vm\")"

# INCLUDED_emacs20=""
# INCLUDED_emacs21=""
# INCLUDED_xemacs21=""

# EXCLUDED_emacs20=""
# EXCLUDED_emacs21=""
# EXCLUDED_xemacs21=""
# EXCLUDED_emacs_snapshot=""
emacs-goodies-el-35.8ubuntu2/debian/emacsen-install.template0000775000000000000000000000772612230377266021070 0ustar  eval included_here=\$$(echo INCLUDED_$FLAVOR | tr - _)
eval excluded_here=\$$(echo EXCLUDED_$FLAVOR | tr - _)
eval sourceonly_here=\$$(echo SOURCEONLY_$FLAVOR | tr - _)

included_all=$(for i in ${!INCLUDED_*} ; do
    eval echo \$$i
    done | sort -u)

excluded_all=$(for i in ${!EXCLUDED_*} ; do
    eval echo \$$i
    done | sort -u)

sourceonly_all=$(for i in ${!SOURCEONLY_*} ; do
    eval echo \$$i
    done | sort -u)

if [ ${FLAVOR} = emacs ]; then exit 0; fi

# Install-info-altdir does not actually exist. 
# Maybe somebody will write it.
if test -x /usr/sbin/install-info-altdir; then
    echo install/${PACKAGE}: install Info links for ${FLAVOR}
    install-info-altdir --quiet --section "" "" --dirname=${FLAVOR} /usr/info/${PACKAGE}.info.gz
fi

LOG=`tempfile -pelc_ -s.log -m644`
ELDIR=/usr/share/emacs/site-lisp/${PACKAGE}
ELCDIR=/usr/share/${FLAVOR}/site-lisp/${PACKAGE}
if test -e "${ELCDIR}/${STAMPFILE}"; then
    echo "${PACKAGE} files already compiled in ${ELCDIR}."
    rm -f ${LOG}
    exit
fi
echo install/${PACKAGE}: Handling ${FLAVOR}, logged in ${LOG}

if [ -z "$FLAGS" ] ; then
#   FLAGS="-q -no-site-file --no-site-file -batch -l path.el -f batch-byte-compile
    FLAGS="-batch -l path.el -f batch-byte-compile"
fi

install -m 755 -d ${ELCDIR}
cd ${ELDIR}

# Now to compute the list of files to install...

FILES=$(ls -1 *.el)
# Here we have all of them

PATTERN=""
for i in $included_all $excluded_all $sourceonly_all; do
    [ ! -z "$PATTERN" ] && PATTERN="${PATTERN}\|"
    PATTERN="${PATTERN}^$i\$"
done
FILES2=$FILES
if [ ! -z "$PATTERN" ] ; then
    FILES=$(for i in $FILES2 ; do echo $i | grep -v $PATTERN || true ; done)
fi
# Here we only have those not explicitly included or excluded by any flavour

FILES="$FILES $included_here"
# Here we also have those included for the current flavour

for i in $excluded_all ; do
    include_i="yes"
    for j in $excluded_here ; do
	[ $i = $j ] && include_i="no"
    done
    [ $include_i = "yes" ] && FILES="$FILES $i"
done
# And now we have those excluded by other flavours but not the current one

FILES=$(for i in $FILES ; do echo $i ; done | sort -u)
# And now for my last trick...  The list is now uniquified!

# Symlinks instead of copying...
cd ${ELCDIR}
for i in $FILES $sourceonly_all; do
    ln -fs /usr/share/emacs/site-lisp/${PACKAGE}/$i
done

# Prepare the flavour specific autoload file
if [ ${PACKAGE} = emacs-goodies-el ]; then
   echo Building autoloads for ${FLAVOR} in ${ELCDIR}
   if [ $FLAVOR != xemacs21 ]; then
      echo ";;; emacs-goodies-loaddefs.el" > emacs-goodies-loaddefs.el
      echo ";;  autoloads generated upon installation of the emacs-goodies-el package" >> emacs-goodies-loaddefs.el
   fi
   echo ${FLAVOR} -batch --no-site-file --multibyte --eval '(setq load-path (cons "." load-path))' -l autoload --eval '(setq generated-autoload-file (expand-file-name "emacs-goodies-loaddefs.el"))' --eval '(setq make-backup-files nil)' -f batch-update-autoloads . >> ${LOG}
   cd ${ELCDIR}
   "${FLAVOR}" -batch --no-site-file --multibyte --eval '(setq load-path (cons "." load-path))' -l autoload --eval '(setq generated-autoload-file (expand-file-name "emacs-goodies-loaddefs.el"))' --eval '(setq make-backup-files nil)' -f batch-update-autoloads . >> ${LOG}  2>&1
   echo "(provide 'emacs-goodies-loaddefs)" >> emacs-goodies-loaddefs.el
fi

echo "(setq load-path (cons \".\" load-path) byte-compile-warnings nil)" > path.el
if test "${APPEND_LOAD_PATH}" != ""
then
	echo "(setq load-path (append ${APPEND_LOAD_PATH} load-path))" >> path.el
fi

# Prevent epg from manipulating /root/.gnupg (#689807)
if [ ${PACKAGE} = gnus-bonus-el ]; then
	TMPGNUPGHOME=`mktemp -d --tmpdir gnupg.XXXXXXXXXX`
	echo "(setq epg-gpg-home-directory \"${TMPGNUPGHOME}\")" >> path.el
fi

echo ${FLAVOR} ${FLAGS} ${FILES} >> ${LOG}
"${FLAVOR}" ${FLAGS} ${FILES} >> ${LOG} 2>&1
egrep -s -e "While compiling|\*\*" ${LOG} || /bin/true
echo install/${PACKAGE}: Deleting ${LOG}
rm -f path.el ${LOG}

if [ ${PACKAGE} = gnus-bonus-el ]; then
	rm -rf ${TMPGNUPGHOME}
fi

exit 0
emacs-goodies-el-35.8ubuntu2/debian/control0000775000000000000000000001722312323027231015633 0ustar  Source: emacs-goodies-el
Section: editors
Priority: optional
Maintainer: Ubuntu Developers 
XSBC-Original-Maintainer: Peter S Galbraith 
Build-Depends: debhelper (>= 7), quilt (>= 0.46-7), texinfo
Standards-Version: 3.9.0
Vcs-Cvs: :pserver:anonymous@cvs.alioth.debian.org:/cvs/pkg-goodies-el emacs-goodies-el
Vcs-Browser: http://alioth.debian.org/scm/viewvc.php/?root=pkg-goodies-el

Package: emacs-goodies-el
Architecture: all
Depends: emacs24 | emacsen, bash (>= 2.05a) | bash-static, ${misc:Depends}, dpkg (>= 1.15.4) | install-info
Recommends: dict, wget, perl-doc
Replaces: emacs-goodies-extra-el
Provides: emacs-goodies-extra-el
Description: Miscellaneous add-ons for Emacs
 This package contains:
  align-string - align string components over several lines;
  all - edit all lines matching a given regexp;
  apache-mode - major mode for editing Apache configuration files;
  ascii - ASCII code display for character under point;
  auto-fill-inhibit - finer grained control over auto-fill-mode;
  bar-cursor - change your cursor to a bar instead of a block;
  bm - visible bookmarks in buffers;
  boxquote - quote texts in nice boxes;
  browse-huge-tar - browse tar files without reading them into memory;
  browse-kill-ring - browse, search, modify the kill ring;
  clipper - save strings of data for further use;
  coffee - now Emacs can even brew coffee;
  color-theme - changes the colors used within Emacs;
  csv-mode - major mode for comma-separated value files;
  ctypes - enhanced Font lock support for custom defined types;
  dedicated - make a window dedicated to a single buffer;
  df - display in the mode line space left on devices;
  dict - wrapper around the 'dict' command. (Depends on bash and dict)
  diminish - shorten or erase modeline presence of minor modes;
  dir-locals - provides directory-wide local variables;
  edit-env - display, edit, delete and add environment variables;
  egocentric - highlight your name inside emacs buffers;
  eproject - assign files to projects, programatically
  ff-paths - $PATH-like searching in C-x C-f;
  filladapt - enhances Emacs's built-in adaptive fill;
  floatbg - slowly modify background color;
  framepop - display temporary buffers in a dedicated frame;
  graphviz-dot-mode.el - mode for the dot-language used by graphviz (att).
  highlight-beyond-fill-column - highlight lines that are too long;
  highlight-completion - highlight completions in the minibuffer;
  highlight-current-line - highlight line where the cursor is;
  home-end - alternative Home and End commands;
  htmlize - HTML-ize font-lock buffers;
  initsplit - split customizations into different files;
  joc-toggle-buffer - fast switching between two buffers;
  joc-toggle-case - a set of functions to toggle the case of characters;
  keydef - a simpler way to define key mappings;
  keywiz - Emacs key sequence quiz;
  lcomp - list-completion hacks;
  maplev - major mode for Maple;
  map-lines - map a command over lines matching a regexp;
  markdown-mode - major mode for editing Markdown files;
  marker-visit - navigate through a buffer's marks in order;
  matlab - major mode for MatLab dot-m files;
  minibuf-electric -  electric minibuffer behavior from XEmacs;
  minibuffer-complete-cycle - cycle through the *Completions* buffer;
  miniedit - enhanced editing for minibuffer fields;
  mutt-alias - lookup and insert the expansion of mutt mail aliases;
  muttrc-mode - major mode for editing Mutt config files;
  obfusurl - obfuscate an URL;
  pack-windows - resize all windows to display as much info as possible;
  perldoc - show help for Perl functions and modules. (Depends on perl-doc);
  pod-mode - major mode for editing POD files;
  pp-c-l - display Control-l characters in a pretty way;
  projects - create project-based meaningful buffer names;
  prot-buf - protect buffers from accidental killing;
  protocols - perform lookups in /etc/protocols;
  quack - enhanced support for editing and running Scheme code;
  rfcview - view IETF RFCs with readability-improved formatting;
  services - perform lookups in /etc/services;
  session - saves settings between Emacs invocations and visits to a file;
  setnu - setnu-mode, a vi-style line number mode;
  shell-command - enables tab-completion for shell-command;
  show-wspace - highlight whitespaces of various kinds;
  silly-mail - generate bozotic mail headers;
  slang-mode.el - a major-mode for editing S-Lang scripts;
  sys-apropos - interface for the *nix apropos command;
  tabbar - Display a tab bar in the header line;
  tail - "tail -f" a file or a command from within Emacs;
  tc - cite text with proper filling;
  thinks - quote texts in cartoon-like think bubbles;
  tlc - major mode for editing Target Language Compiler scripts;
  tld - explain top-level domain names;
  todoo - major mode for editing TODO files;
  toggle-option - easily toggle frequently toggled options;
  twiddle - mode line hacks to keep you awake;
  under - underline a region with ^ characters;
  upstart-mode - mode for editing upstart files;
  xrdb-mode - mode for editing X resource database files.
 .
 See /usr/share/doc/emacs-goodies-el/README.Debian.gz for a short
 description of all files, or the Info node `emacs-goodies-el' for details.

Package: devscripts-el
Architecture: all
Depends: emacs24 | emacsen, bash (>= 2.05a), devscripts, dpkg-dev-el, apel, ${misc:Depends}
Recommends: elserv
Description: Emacs wrappers for the commands in devscripts
 This package contains:
  devscripts - wrappers around the debuild, debc and debi commands;
  pbuilder-log-view - wrappers around viewing pbuilder logs;
  pbuilder - wrappers around pbuilder
 .
 See /usr/share/doc/devscripts-el/README.Debian for a short description.

Package: debian-el
Architecture: all
Depends: emacs24 | emacsen, reportbug (>= 4.12), ${misc:Depends}, dpkg (>= 1.15.4) | install-info, bzip2, file
Recommends: wget, dlocate, groff-base
Suggests: gnus
Replaces: debbugs-el, debview
Provides: debbugs-el, debview
Section: utils
Description: Emacs helpers specific to Debian users
 This package contains:
 .
  apt-sources - major mode for editing Debian sources.list files;
  apt-utils - interface to APT (Debian package management);
  debian-bug - an Emacs command to submit a bug report;
  deb-view - view contents of Debian package, similarly to tar-mode;
  gnus-BTS - provides buttons for bug numbers seen in Gnus messages;
  preseed - major mode for editing debian-installer preseed files.
 .
 See /usr/share/doc/debian-el/README.Debian for a short description of
 all files, or the Info node `debian-el' for details.

Package: dpkg-dev-el
Architecture: all
Depends: emacs24 | emacsen, debian-el (>= 33.2), ${misc:Depends}
Suggests: dpkg-dev
Recommends: wget
Conflicts: dpkg-dev (<< 1.7.2)
Section: utils
Description: Emacs helpers specific to Debian development
 This package contains:
 .
  debian-bts-control - builds control@bugs.debian.org email messages;
  debian-changelog-mode - a helper mode for Debian changelogs;
  debian-control-mode - a helper mode for debian/control files;
  debian-copyright - major mode for Debian package copyright files;
  readme-debian - major mode for editing README.Debian files.
 .
 See /usr/share/doc/dpkg-dev-el/README.Debian for a short description of
 all files.

Package: vm-bonus-el
Architecture: all
Depends: vm (>= 8.0.12-1), bogofilter, procmail, ${misc:Depends}
Section: mail
Description: vm-bogofilter add-on for VM 
 This package contains vm-bogofilter, an Emacs-Lisp files that provide
 extra support to VM, a mail user agent for Emacs.
 .
 This package contains:
  vm-bogofilter.el - Interface between VM and the bogofilter spam filter.
 .
 See /usr/share/doc/vm-bonus-el/README.Debian for short description
 of the file and its configuration.
emacs-goodies-el-35.8ubuntu2/debian/emacs-goodies-el.install0000775000000000000000000001545012230377266020752 0ustar  elisp/emacs-goodies-el/align-string.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/all.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/apache-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/ascii.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/auto-fill-inhibit.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/bar-cursor.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/bm.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/boxquote.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/browse-huge-tar.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/browse-kill-ring.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/coffee.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/color-theme.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/color-theme-library.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/color-theme_seldefcustom.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/clipper.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/csv-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/ctypes.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/dedicated.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/df.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/dict.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/diminish.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/dir-locals.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/edit-env.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/eproject.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/eproject-extras.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/egocentric.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/emacs-goodies-custom.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/emacs-goodies-el.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/ff-paths.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/filladapt.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/floatbg.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/folding.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/framepop.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/graphviz-dot-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/highlight-beyond-fill-column.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/highlight-completion.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/highlight-current-line.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/home-end.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/htmlize.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/initsplit.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/joc-toggle-buffer.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/joc-toggle-case.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/keydef.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/keywiz.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/lcomp.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/maplev.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/map-lines.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/markdown-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/marker-visit.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/matlab.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/minibuf-electric.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/minibuffer-complete-cycle.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/miniedit.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/mutt-alias.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/muttrc-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/obfusurl.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/pack-windows.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/perldoc.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/pp-c-l.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/pod-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/projects.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/protbuf.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/protocols.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/quack.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/rfcview.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/services.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/session.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/setnu.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/shell-command.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/show-wspace.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/silly-mail.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/slang-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/sys-apropos.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/tabbar.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/tail.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/tc.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/thinks.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/tlc.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/tld.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/todoo.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/toggle-option.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/twiddle.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/under.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/upstart-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/
elisp/emacs-goodies-el/xrdb-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/
emacs-goodies-el-35.8ubuntu2/debian/devscripts-el.README.Debian0000775000000000000000000000162512230377266021070 0ustar    This is an introductory starter for the various goodies included
devscripts-el.  It does not intend to replace reading the documentation
that is made available in the files themselves (or not available at all,
except insofar as code is self-documenting).

Introduction to files in devscripts-el
--------------------------------------

devscripts.el provides

 M-x debuild
 M-x debc
 M-x debi
 M-x debclean
 M-x debdiff

commands to call the corresponding utilities from within Emacs.

pbuilder-mode.el provides

 M-x pdebuild
 M-x pdebuild-user-mode-linux
 M-x pbuilder-build
 M-x pbuilder-user-mode-linux-build
 M-x debuild-pbuilder

commands to call the corresponding utilities from within Emacs.

pbuilder-log-view-mode.el provides

 M-x pbuilder-log-view-elserv

command to view pbuilder and debuild logs from Mozilla through elserv web
server.

 -- Peter S Galbraith , Mon Oct 24 21:09:09 2005
emacs-goodies-el-35.8ubuntu2/debian/dpkg-dev-el.emacsen-startup0000775000000000000000000000123412230377266021374 0ustar  ;; -*-emacs-lisp-*-
;;
;; Emacs startup file for the Debian GNU/Linux dpkg-dev-el package

(cond
 ((not (file-exists-p "/usr/share/emacs/site-lisp/dpkg-dev-el"))
  (message "Package dpkg-dev-el removed but not purged.  Skipping setup."))
 ((not (file-exists-p (concat "/usr/share/"
                              (symbol-name debian-emacs-flavor)
                              "/site-lisp/dpkg-dev-el/readme-debian.elc")))
  (message "Package dpkg-dev-el not fully installed.  Skipping setup."))
 (t
  (debian-pkg-add-load-path-item
   (concat "/usr/share/"
           (symbol-name debian-emacs-flavor)
           "/site-lisp/dpkg-dev-el"))

  (require 'dpkg-dev-el)))
emacs-goodies-el-35.8ubuntu2/debian/gnus-bonus-el.emacsen-remove.in0000775000000000000000000000014612230377266022174 0ustar  #!/bin/sh -e
# /usr/lib/emacsen-common/packages/remove/gnus-bonus-el

FLAVOR=$1
PACKAGE=gnus-bonus-el
emacs-goodies-el-35.8ubuntu2/debian/debian-el.install0000775000000000000000000000104012230377266017443 0ustar  elisp/debian-el/apt-sources.el /usr/share/emacs/site-lisp/debian-el/
elisp/debian-el/apt-utils.el /usr/share/emacs/site-lisp/debian-el/
elisp/debian-el/deb-view.el /usr/share/emacs/site-lisp/debian-el/
elisp/debian-el/debian-bug.el /usr/share/emacs/site-lisp/debian-el/
elisp/debian-el/debian-el.el /usr/share/emacs/site-lisp/debian-el/
elisp/debian-el/debian-el-loaddefs.el /usr/share/emacs/site-lisp/debian-el/
elisp/debian-el/gnus-BTS.el /usr/share/emacs/site-lisp/debian-el/
elisp/debian-el/preseed.el /usr/share/emacs/site-lisp/debian-el/
emacs-goodies-el-35.8ubuntu2/debian/emacs-goodies-el.emacsen-remove.in0000775000000000000000000000015412230377266022612 0ustar  #!/bin/sh -e
# /usr/lib/emacsen-common/packages/remove/emacs-goodies-el

FLAVOR=$1
PACKAGE=emacs-goodies-el